propre.rpls coverage - 94.64%

Files
Source

#' Creation du tableau sur l anciennete du parc (chapitre anciennete et etat energetique).
#'
#' @description Création du tableau 1 du chapitre 4 en html.
#'
#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref.
#' @param annee Une année parmi les millesimes sélectionnables par l'utilisateur, au format numerique.
#' @param epci un booléen pour indiquer si l'on souhaite détailler le tableau par EPCI.
#' @param add_scroll un booleen pour indique si l'on souhaite inserer une scrollbox.  (par défaut FALSE)
#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Répartition des logements sociaux selon leur ancienneté au 1er janvier {annee}")
#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
#'
#' @return Une liste de 3 objets : un graphique en courbes interactif au format html (viz),
#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
#'
#' @importFrom dplyr filter mutate arrange select pull ends_with starts_with
#' @importFrom forcats fct_relevel
#' @importFrom glue glue
#' @importFrom kableExtra kable kable_styling row_spec add_indent footnote scroll_box
#' @importFrom rlang .data
#'
#' @export
#'
#' @examples
#' indicateurs_rpls_illustrations <- lire_rpls_exemple() %>%
#'  dplyr::filter(Zone_ref)
#'
#' creer_tableau_4_1(data = indicateurs_rpls_illustrations, annee = 2019, epci = FALSE,
#' add_scroll = FALSE, note_de_lecture = "")[["viz"]]


creer_tableau_4_1 <- function(data, annee, epci = FALSE,
                              add_scroll = FALSE,
                              titre = NULL,
                              note_de_lecture = ""){

  if (is.null(titre)){
    titre <- "R\u00e9partition des logements sociaux selon leur anciennet\u00e9<br>au 1er janvier {annee}"}

  # une fonction de calcul et de formatage des pourcentages du tableau
  mef <- function(x, y) {
    round(x / y * 100, 1) %>%
      format_fr_pct()
  }

  deformat <- function(x = format_fr_pct(0.10)) {
    gsub(",", ".", x) %>% gsub(".%$", "", .) %>% as.numeric()/100
  }


  # Création du dataset utile pour la production du tableau
  tab <- data %>%
    # Filtre sur l'année N
    dplyr::filter(.data$millesime == annee) %>%
    # Modification de l'ordre des levels de la variable TypeZone
    dplyr::mutate(taux_ls_age_0_5 = mef(.data$nb_ls_age_0_5, .data$nb_ls_actif),
                  taux_ls_age_5_10 = mef(.data$nb_ls_age_5_10, .data$nb_ls_actif),
                  taux_ls_age_10_20 = mef(.data$nb_ls_age_10_20, .data$nb_ls_actif),
                  taux_ls_age_20_40 = mef(.data$nb_ls_age_20_40, .data$nb_ls_actif),
                  taux_ls_age_40_60 = mef(.data$nb_ls_age_40_60, .data$nb_ls_actif),
                  taux_ls_age_60_plus = mef(.data$nb_ls_age_60_plus, .data$nb_ls_actif)) %>%
    dplyr::select(dplyr::ends_with("Zone"), "taux_ls_age_0_5", "taux_ls_age_5_10", "taux_ls_age_10_20",
                  "taux_ls_age_20_40", "taux_ls_age_40_60", "taux_ls_age_60_plus") %>%
    # Tri de la table pour faire apparaitre dans l'ordre FM/Région/Département/EPCI
    propre.rpls::arrange_zonage()

  if(!epci){
    tab <- dplyr::filter(tab, .data$TypeZone != "Epci")
  }

  # Création du tableau
  tableau <- tab %>%
    # Sélection des variables utiles
    dplyr::select(-"TypeZone", -"CodeZone") %>%
    # Mise en place des titres de colonnes
    kableExtra::kable("html", col.names=c("Zone",
                                          "Logements \u00e2g\u00e9s\nde moins\u00a0de\u00a05\u00a0ans",
                                          "Logements \u00e2g\u00e9s\nde 5\u00a0\u00e0\u00a09\u00a0ans",
                                          "Logements \u00e2g\u00e9s\nde 10\u00a0\u00e0\u00a019\u00a0ans",
                                          "Logements \u00e2g\u00e9s\nde 20\u00a0\u00e0\u00a039\u00a0ans",
                                          "Logements \u00e2g\u00e9s\nde 40\u00a0\u00e0\u00a059\u00a0ans",
                                          "Logements \u00e2g\u00e9s\nde plus\u00a0de\u00a060\u00a0ans"),
                      format.args = list(big.mark = " "),
                      align = "lrrrrrr",
                      caption = glue::glue(titre)) %>%
    # Formatage de la taille des caractères
    kableExtra::kable_styling(font_size = 12) %>%
    # Formatage de la ligne "R\u00e9gion" : fond blanc, gras
    kableExtra::row_spec(which(dplyr::pull(tab, "TypeZone") == "R\u00e9gions"), bold = TRUE, background = "#FFFFFF") %>%
    # Formatage des lignes "D\u00e9partements" : fond gris clair, gras
    kableExtra::row_spec(which(dplyr::pull(tab, "TypeZone") == "D\u00e9partements"), bold = TRUE, background = "#E5E5E5") %>%
    # Formatage des lignes "Epci" et "EPT" : fond blanc, taille 10
    kableExtra::row_spec(which(dplyr::pull(tab, "TypeZone") %in% c("EPT", "Epci")), bold = FALSE, background = "#FFFFFF",
                         font_size = 10) %>%
    # Ajout d'une indentation pour les lignes "Epci" et "EPT"
    kableExtra::add_indent(which(dplyr::pull(tab, "TypeZone")  %in% c("EPT", "Epci"))) %>%
    # Formatage des lignes "France" : fond gris foncé, gras
    kableExtra::row_spec(which(dplyr::pull(tab, "TypeZone") == "France"), bold = TRUE, background = "#C4C4C4") %>%
    # Création note de bas de page avec la source et l ajout parametrable d une note de lecture
    kableExtra::footnote(general = paste0(dplyr::if_else(note_de_lecture != "",
                                                         paste0(note_de_lecture, "\n"),
                                                         ""),
                                          caption(sources = 1, mil_rpls = annee)), general_title = "")

  # insere une scrollbox pour une meilleure lisibilite
  if (add_scroll) {
    tableau <- tableau %>%
      kableExtra::scroll_box(width = "100%", height = "500px", fixed_thead = TRUE)
  }

  # metadonnees a faire figurer dans la table des matiere de l'export xls
  index <- data.frame(onglet = "tableau_4_1", titre = glue::glue(titre) %>% gsub("<br>", " ", .))

  # donnees a faire figurer de l'export xls (typage numerique)
  tab2 <- tab %>%
    dplyr::mutate(dplyr::across(dplyr::starts_with("taux_ls_age_"), deformat))


  return(list(viz = tableau, tab_xls = tab2, meta = index))



}

#' Chapitre 4: Verbatim
#'
#' @description Production des commentaires verbatim du chapitre 4.

#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref
#' @param annee Le millesime renseigné par l'utilisateur (au format numérique)
#'
#' @return Un vecteur de 3 chaînes de caractères comprenant le titre, l'intertitre et les commentaires essentiels du chapitre 4
#'
#' @importFrom dplyr filter pull mutate
#' @importFrom glue glue
#' @importFrom propre.datareg datareg
#' @importFrom rlang .data
#'
#' @export
#'
#' @examples
#' indic_rpls_ref <- propre.rpls::lire_rpls_exemple() %>%
#'  dplyr::filter(Zone_ref)
#'
#' creer_verbatim_4(data = indic_rpls_ref, annee = 2019)[["titre"]]
#' creer_verbatim_4(data = indic_rpls_ref, annee = 2019)[["intertitre"]]
#' creer_verbatim_4(data = indic_rpls_ref, annee = 2019)[["commentaires"]]


creer_verbatim_4 <- function(data, annee) {

  # on récupère les formulations idiomatiques grâce à {propre.datareg}
  code_region <- dplyr::filter(data, grepl("gions", .data$TypeZone)) %>%
    dplyr::pull("CodeZone") %>% unique %>% as.character

  verb_reg <- propre.datareg::datareg(code_reg = code_region)

  drom <- ifelse(code_region %in% paste0("0", 1:6), TRUE, FALSE)

  prepdata <- data %>%
    dplyr::filter(.data$millesime == annee) %>%
    dplyr::mutate(nb_dpe_connus = .data$nb_ls_dpe_ener_A + .data$nb_ls_dpe_ener_B + .data$nb_ls_dpe_ener_C + .data$nb_ls_dpe_ener_D + .data$nb_ls_dpe_ener_E + .data$nb_ls_dpe_ener_F + .data$nb_ls_dpe_ener_G,
                  part_ls_dpe_ener_a_b = (.data$nb_ls_dpe_ener_A + .data$nb_ls_dpe_ener_B) / .data$nb_dpe_connus * 100,
                  part_ls_dpe_ener_f_g = (.data$nb_ls_dpe_ener_F + .data$nb_ls_dpe_ener_G) / .data$nb_dpe_connus * 100,
                  anciennete_moyenne = .data$age_moyen)

  part_dpe_renseigne_reg <- prepdata %>%
    dplyr::filter(.data$TypeZone == "R\u00e9gions")  %>%
    dplyr::pull("part_dpe_realise") %>%
    format_fr_pct()

  part_a_b_reg <- prepdata %>%
    dplyr::filter(.data$TypeZone == "R\u00e9gions")  %>%
    dplyr::pull("part_ls_dpe_ener_a_b") %>%
    format_fr_pct()

  part_f_g_reg <- prepdata %>%
    dplyr::filter(.data$TypeZone == "R\u00e9gions")  %>%
    dplyr::pull("part_ls_dpe_ener_f_g") %>%
    format_fr_pct()

  # on a besoin de l'âge avec des décimales pour comparer l'ancienneté des parcs (régional et national)
  anciennete_moyenne_reg_brut <- prepdata %>%
    dplyr::filter(.data$TypeZone == "R\u00e9gions")  %>%
    dplyr::pull("anciennete_moyenne")
  anciennete_moyenne_reg <- anciennete_moyenne_reg_brut  %>%
    format_fr_nb()

  anciennete_moyenne_f_brut <- prepdata %>%
    dplyr::filter(grepl("FRMETRO", .data$CodeZone))  %>%
    dplyr::pull("anciennete_moyenne")
  anciennete_moyenne_f <- anciennete_moyenne_f_brut  %>%
    format_fr_nb()

  if(drom) {
    libelle_f <- "sur l\'ensemble de la France"
  } else {
    part_dpe_renseigne_f <- prepdata %>%
      dplyr::filter(.data$TypeZone == "FRMETRO")  %>%
      dplyr::pull("part_dpe_realise") %>%
      format_fr_pct()
    part_a_b_f <- prepdata %>%
      dplyr::filter(.data$CodeZone == "FRMETRO")  %>%
      dplyr::pull("part_ls_dpe_ener_a_b") %>%
      format_fr_pct()
    part_f_g_f <- prepdata %>%
      dplyr::filter(.data$CodeZone == "FRMETRO")  %>%
      dplyr::pull("part_ls_dpe_ener_f_g") %>%
      format_fr_pct()
    libelle_f <- "en France m\u00e9tropolitaine"
  }


  titre_ch4 <- ifelse(drom, "L\'anciennet\u00e9 du parc social", "L\'anciennet\u00e9 et l\'\u00e9tat \u00e9nerg\u00e9tique du parc social")


  if(anciennete_moyenne_reg_brut - anciennete_moyenne_f_brut < -1.5) {
    qualificatif_anciennete <- "plus r\u00e9cent qu\'"
  } else if(anciennete_moyenne_reg_brut - anciennete_moyenne_f_brut > 1.5) {
    qualificatif_anciennete <- "plus ancien qu\'"
  } else {
    qualificatif_anciennete <- "comparable "
  }

  verbatim_chap_4 <- list(titre = titre_ch4, intertitre ="", commentaires ="")


  verbatim_chap_4$intertitre <- glue::glue("Un parc social {qualificatif_anciennete}au niveau national")

  commentaires <- glue::glue(
    "Au 1er janvier {annee}, l\u2019anciennet\u00e9 moyenne du parc de logements sociaux {verb_reg$de_la_region_nom_region} ",
    "est de {anciennete_moyenne_reg} ans, ")

  if(anciennete_moyenne_reg != anciennete_moyenne_f){
    verbatim_chap_4$commentaires <- glue::glue(commentaires, "contre {anciennete_moyenne_f} ans {libelle_f}. ")
  } else {
    verbatim_chap_4$commentaires <- glue::glue(commentaires, "comme {libelle_f}. ")
  }


  if (!drom) {
    commentaires_metro <- glue::glue("L\u2019anciennet\u00e9 des constructions influe sur le diagnostic de performance \u00e9nerg\u00e9tique
  des logements (DPE). A la fin de l\u2019ann\u00e9e {annee -1}, {part_dpe_renseigne_reg} des logements du parc locatif social de la r\u00e9gion ont fait l\u2019objet
  d\u2019un DPE (r\u00e9alis\u00e9 selon les r\u00e8gles en vigueur avant le 1er juillet 2021).
  Les logements class\u00e9s en A et B, consid\u00e9r\u00e9s comme peu \u00e9nergivores, repr\u00e9sentent {part_a_b_reg} du parc social disposant d\u2019un DPE renseign\u00e9, contre {part_a_b_f} en France m\u00e9tropolitaine. Les logements class\u00e9s en F et G, qualifi\u00e9s de \u00ab\u00a0passoires thermiques\u00a0\u00bb
  et consid\u00e9r\u00e9s comme tr\u00e8s \u00e9nergivores, en repr\u00e9sentent {part_f_g_reg} ({part_f_g_f} au niveau national).")

    verbatim_chap_4$commentaires <- glue::glue(verbatim_chap_4$commentaires, commentaires_metro)
  }

  verbatim_chap_4
  }


#' Creation de la carte represantant les loyers moyens au m2 par EPCI (chap Loyers et financements).
#'
#' @description Creation de la carte des loyers moyens/m² par EPCI.
#'
#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur.
#' @param annee Une annee, parmi les millesimes selectionnables par l'utilisateur, au format numérique.
#' @param carto La table des fonds de carte realisee avec \code{mapfactory::\link{fond_carto}}.
#' @param bornes Les bornes manuelles.
#' @param palette Choix de la palette de couleurs parmi celle de \code{gouvdown::\link{scale_color_gouv_discrete}}
#' @param inverse Choix du sens de la progression des couleurs : du plus sombre au plus clair (FALSE) ou du plus clair au plus sombre (TRUE)
#' @param maille Le maillage souhaite pour la carte, a choisir parmi "commune", "EPCI" ou "département". "EPCI" par defaut.
#' @param titre Une chaine de caractère si vous voulez ajouter un titre specifique. (par défaut: "Loyer moyen par {maille} au 1er janvier {annee}")
#' @param note_de_lecture Une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
#' @param na_label L'etiquette à afficher dans la legende pour les valeurs manquantes ("Valeurs manquantes" par défaut).
#' @param ... Autres paramètres de la fonction [\code{mapfactory::creer_carte}](https://dreal-pdl.gitlab-pages.din.developpement-durable.gouv.fr/csd/mapfactory/reference/creer_carte.html)
#'
#' @return Une liste de 3 objets : Une carte choroplethe mise en page au format html (viz),
#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
#'
#' @importFrom dplyr filter slice pull if_else select
#' @importFrom glue glue
#' @importFrom mapfactory creer_carte
#' @importFrom COGiter list_epci_in_reg list_com_in_reg
#' @export
#'
#' @examples
#' indicateurs_rpls <- lire_rpls_exemple()
#'
#' creer_carte_6_1(data = indicateurs_rpls,
#'                 annee = 2019,
#'                 carto = mapfactory::fond_carto("Corse"),
#'                 bornes = NULL,
#'                 note_de_lecture = ""
#' )[["viz"]]

creer_carte_6_1 <- function(data, annee, carto, bornes = NULL, palette = "pal_gouv_i", inverse = TRUE, maille = "EPCI",
                            titre = "Loyer moyen par {maille} \nau 1er janvier {annee}", note_de_lecture = "",
                            na_label = "Valeurs manquantes", ...) {

  # récupérer le code de la région à partir du jeu de données
  reg <- data %>%
    dplyr::filter(.data$TypeZone == "R\u00e9gions", .data$Zone_ref == TRUE) %>%
    dplyr::slice(1) %>%
    dplyr::pull("CodeZone") %>%
    as.character()

  # preparer la table à visualiser
  data <- data %>%
    dplyr::filter(.data$millesime == annee)

  map <- mapfactory::creer_carte(data = data, code_region = reg, carto = carto, maillage = maille, indicateur = loyer_m2,
                                 type_viz = "choroplethe", palette = palette, inverse = inverse, interactive = TRUE,
                                 titre = glue::glue(titre), sous_titre = "en \u20AC/m\u00B2 de surface habitable",
                                 bas_de_page = dplyr::if_else(note_de_lecture != "" ,
                                                              paste0(note_de_lecture, "\n\n", caption(sources = 1, mil_rpls = annee)),
                                                              caption(sources = 1, mil_rpls = annee)),
                                 evolution = FALSE, suffixe = " \u20AC/m\u00B2", na_label = na_label, bornes = bornes, ...)


  # donnees a faire figurer dans l'export xls
  codes_zones_a_garder <- c(COGiter::list_epci_in_reg(reg), COGiter::list_com_in_reg(reg))
  data_xls <- data %>%
    # filtre sur la region et la maille de la carte, attention les noms de mailles dans TypeZone sont légèrement différents du paramètre maille
    dplyr::filter(grepl(tolower(maille), tolower(.data$TypeZone)), .data$CodeZone %in% codes_zones_a_garder) %>%
    dplyr::select("CodeZone", "Zone", "loyer_m2")

  # metadonnees a faire figurer dans la table des matiere de l'export xls
  index <- data.frame(onglet = "carte_6_1", titre = glue::glue(titre) %>% gsub("\n", "", .))

  return(list(viz = map, tab_xls = data_xls, meta = index))

}

#' Chapitre 1: Verbatim
#'
#' @description Production des commentaires verbatim du chapitre 1.

#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref
#' @param annee Le millesime renseigné par l'utilisateur (au format numérique)
#'
#' @return Une chaîne de caractères comprenant les commentaires essentiels du chapitre 1
#'
#' @importFrom dplyr filter mutate select transmute case_when pull
#' @importFrom tidyr pivot_wider
#' @importFrom glue glue
#' @importFrom propre.datareg datareg
#' @importFrom rlang .data
#'
#' @export
#'
#' @examples
#' indic_rpls_ref <- propre.rpls::lire_rpls_exemple() %>%
#'  dplyr::filter(Zone_ref)
#'
#' creer_verbatim_1(data = indic_rpls_ref, annee = 2020)
#'

creer_verbatim_1 <- function(data, annee) {

  # on calcule d'abord les indicateurs nécessaires aux commentaires
  evol_n_nmoins_1 <- data %>%
    # on garde les lignes pertinentes, Fce metro si reg metropolitaine (CodeZone == FRMETRO) ou Fce entiere si DROM (CodeZone == FRMETRODROM)
    dplyr::filter(.data$millesime == annee, grepl("gions", .data$TypeZone) | grepl("FRMETRO", .data$CodeZone)) %>%
    # on normalise le lib des millesimes
    dplyr::select("millesime", "TypeZone", "evolution_n_nmoins1") %>%
    dplyr::transmute(TypeZone = substr(.data$TypeZone, 1, 1), # on simplifie le lib de niv geo pour limiter les soucis d'encodage
                     evolution_n_nmoins1 = round(evolution_n_nmoins1, 1)) %>%
    tidyr::pivot_wider(names_from = "TypeZone", values_from = "evolution_n_nmoins1", names_prefix = ".") %>%
    dplyr::mutate(qual_evol_reg = dplyr::case_when(
      (.data$.R - .data$.F) > 0.5 ~  "plus importante",
      (.data$.R - .data$.F) > 0.1 ~  "l\u00e9g\u00e8rement plus importante",
      (.data$.R - .data$.F) > -0.1 ~  "\u00e9quivalente",
      (.data$.R - .data$.F) > -0.5 ~  "un peu moindre",
      (.data$.R - .data$.F) <= -0.5 ~  "moindre")
      )

  evol_pluriannuelles <- data %>%
    # on garde la ligne pertinente
    dplyr::filter(.data$millesime == annee, grepl("gions", .data$TypeZone)) %>%
    # on normalise le lib des millesimes
    dplyr::select("millesime", "TypeZone", "evolution_annees_rp", "evolution_rp") %>%
    dplyr::transmute(TypeZone = substr(.data$TypeZone, 1, 1),# on simplifie le lib de niv geo pour limiter les soucis d'encodage
                     evolution_annees_rp = round(.data$evolution_annees_rp, 1),
                     evolution_rp = round(.data$evolution_rp, 1))  %>%
    dplyr::mutate(qual_evol_reg_vs_rp = dplyr::case_when(
      (.data$evolution_annees_rp - .data$evolution_rp) > 0 ~  "davantage que l\'ensemble des",
      (.data$evolution_annees_rp - .data$evolution_rp) < 0 ~  "moins que l\'ensemble des",
      (.data$evolution_annees_rp - .data$evolution_rp) == 0 ~  "de mani\u00e8re comparable aux")
    )

  densite <- data %>%
    dplyr::filter(.data$millesime == annee, grepl("gions", .data$TypeZone) | grepl("FRMETRO", .data$CodeZone)) %>%
    dplyr::transmute(TypeZone = substr(.data$TypeZone, 1, 1),
                     densite_pr_100RP = (100 * .data$nb_ls_actif / .data$nb_rp) %>% round(1))

  # les formulations idiomatiques grâce à {propre.datareg}
  id_reg <- dplyr::filter(data, grepl("gions", .data$TypeZone)) %>%
    dplyr::pull("CodeZone") %>% unique %>% as.character
  verb_reg <- propre.datareg::datareg(code_reg = id_reg)

  # on crée ensuite une liste nommee des differents parametres
  verb1 <- list(nom_reg = verb_reg$dans_la_region_nom_region,
                nb_ls_reg = dplyr::filter(data, grepl("gions", .data$TypeZone), millesime == annee) %>%
                  dplyr::pull("nb_ls_actif") %>% format_fr_nb(dec = 0, big_mark = " "),
                mil = annee,
                evol_n_nmoins1_reg = evol_n_nmoins_1$.R %>% format_fr_pct,
                evol_n_nmoins1_nat = evol_n_nmoins_1$.F %>% format_fr_pct,
                evol_pluriann_reg = evol_pluriannuelles$evolution_annees_rp %>% format_fr_pct,
                nb_an_evol_rp = lgt_rp$nb_an_evol_rp[1],
                evolution_rp = evol_pluriannuelles$evolution_rp %>% format_fr_pct,
                adj_evol_reg_vs_rp = evol_pluriannuelles$qual_evol_reg_vs_rp,
                adj_evol_reg = evol_n_nmoins_1$qual_evol_reg,
                densite_reg = dplyr::filter(densite, .data$TypeZone == "R") %>%
                  dplyr::pull("densite_pr_100RP") %>% format_fr_pct,
                densite_metro_ou_nat = dplyr::filter(densite, .data$TypeZone == "F") %>%
                  dplyr::pull("densite_pr_100RP") %>% format_fr_pct
  )

  # production du verbatim a partir des elements precedents

  ## la premiere phrase est commune a tous
  phrase1 <- glue::glue("L\'offre locative sociale {verb1$nom_reg} s\'\u00e9l\u00e8ve \u00e0 {verb1$nb_ls_reg} logements au 1er janvier {verb1$mil}. ")

  # pour la 2e phrase, on separe les cas ou le parc regional recule ou stagne des cas où le parc regional progresse
  if(verb1$evol_n_nmoins1_reg > 0) {
    phrase2 <- glue::glue("Sur un an, elle augmente de {verb1$evol_n_nmoins1_reg}, soit une progression {verb1$adj_evol_reg} qu\'au niveau national ({verb1$evol_n_nmoins1_nat}). ")
  } else if(verb1$evol_n_nmoins1_reg < 0) {
    verb1$evol_n_nmoins1_reg <- verb1$evol_n_nmoins1_reg %>% gsub("-", "", .)
    phrase2 <- glue::glue("Sur un an, elle diminue de {verb1$evol_n_nmoins1_reg}, alors qu\'elle progresse de {verb1$evol_n_nmoins1_nat} au niveau national. ")
  } else {
    phrase2 <- glue::glue("Sur un an, elle reste stable, alors qu\'elle progresse de {verb1$evol_n_nmoins1_nat} au niveau national. ")
  }

  # pour la 3e phrase, on separe les cas selon si le parc de ls augmente plus/moins que le parc de rp

  phrase3 <- glue::glue("Les logements sociaux ont progress\u00e9 de {verb1$evol_pluriann_reg} en {verb1$nb_an_evol_rp} ans, {verb1$adj_evol_reg_vs_rp} r\u00e9sidences principales sur la p\u00e9riode {lgt_rp$mil_RP_old[1]}-{lgt_rp$mil_RP[1]} ")
  if(verb1$evol_pluriann_reg != verb1$evolution_rp) {
    phrase3 <- glue::glue("{phrase3} ({verb1$evolution_rp}). ")
  } else {
    phrase3 <- glue::glue("{phrase3}. }")
  }

  ## pour la 4e phrase, on separe selon que les rp representent la meme part dans la region qu'au niveau national ou non

  if(verb1$densite_reg != verb1$densite_metro_ou_nat) {
    phrase4 <- glue::glue("Ainsi, le parc social repr\u00e9sente, au 1er janvier {verb1$mil}, {verb1$densite_reg} des r\u00e9sidences principales contre {verb1$densite_metro_ou_nat} au niveau national. ")
  } else {
    phrase4 <- glue::glue("Ainsi, le parc social repr\u00e9sente, au 1er janvier {verb1$mil}, {verb1$densite_reg} des r\u00e9sidences principales, comme au niveau national. ")
  }



  verbatim_chap_1 <- glue::glue("{phrase1}{phrase2}\n\n{phrase3}\n\n{phrase4}")

  verbatim_chap_1
}




#' Chapitre 6: Verbatim
#'
#' @description Production des commentaires et de l'intertitre verbatim du chapitre 6.

#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur
#' @param annee Le millesime renseigné par l'utilisateur (au format numérique)
#'
#' @return Un vecteur de 2 chaînes de caractères comprenant l'intertitre et les commentaires essentiels du chapitre 6
#'
#' @importFrom dplyr filter select transmute pull contains mutate case_when starts_with across everything
#' @importFrom glue glue
#' @importFrom propre.datareg datareg
#' @importFrom rlang .data
#' @importFrom tidyr pivot_wider
#'
#' @export
#'
#' @examples
#' indic_rpls <- propre.rpls::lire_rpls_exemple()
#'
#' creer_verbatim_6(data = indic_rpls, annee = 2019)[["intertitre"]]
#' creer_verbatim_6(data = indic_rpls, annee = 2019)[["commentaires"]]


creer_verbatim_6 <- function(data, annee) {

  # on calcule d'abord les indicateurs necessaires aux commentaires
  mises_svc <- data %>%
    # on garde les lignes pertinentes : Fce metro si reg metropolitaine (CodeZone == FRMETRO) ou Fce entiere si DROM (CodeZone == FRMETRODROM)
    dplyr::filter(.data$millesime == annee, grepl("gion", .data$TypeZone) | grepl("FRMETRO", .data$CodeZone), .data$Zone_ref) %>%
    dplyr::select("millesime", "TypeZone", "nb_plai", "nb_mes", "nb_plus") %>%
    dplyr::transmute(TypeZone = substr(.data$TypeZone, 1, 1), # on simplifie le lib de niv geo pour limiter les soucis d'encodage
                  part_plai = round(.data$nb_plai / .data$nb_mes * 100, 1),
                  part_plus = round(.data$nb_plus / .data$nb_mes * 100, 1)) %>%
    tidyr::pivot_wider(names_from = "TypeZone", values_from = c("part_plai", "part_plus"))

  # une variable pour recuperer l'identifiant de la région choisie
  id_reg <- dplyr::filter(data, .data$Zone_ref, grepl("gion", .data$TypeZone)) %>%
    dplyr::pull("CodeZone") %>% unique() %>% as.character

  # un booleen pour determiner si la region choisie est metropolitaine ou non
  metro <- !(id_reg %in% paste0("0", 1:6))

  loyers_0 <- data %>%
    dplyr::filter(.data$millesime == annee, grepl("gions", .data$TypeZone) | grepl("FRMETRO", .data$CodeZone)) %>%
    dplyr::select(dplyr::contains("Zone"), "somme_loyer", "somme_surface", "somme_loyer_recent", "somme_surface_recent",
                  "somme_loyer_nb_plai", "somme_surface_nb_plai", "somme_loyer_nb_pls", "somme_surface_nb_pls") %>%
    dplyr::mutate(TypeZone = substr(.data$TypeZone, 1, 1),
                  reg_comp = dplyr::case_when(
                    .data$TypeZone != "R" ~ FALSE,
                    .data$TypeZone == "R" & metro & .data$CodeZone %in% paste0("0", 1:6) ~ FALSE,
                    .data$TypeZone == "R" & metro & !(.data$CodeZone %in% paste0("0", 1:6)) ~ TRUE,
                    .data$TypeZone == "R" & !metro & .data$CodeZone %in% paste0("0", 1:6) ~ TRUE,
                    .data$TypeZone == "R" & !metro & !(.data$CodeZone %in% paste0("0", 1:6)) ~ FALSE,
                    TRUE ~ FALSE),
                  loyer_moy = .data$somme_loyer / .data$somme_surface ,
                  loyer_moy_recent = .data$somme_loyer_recent / .data$somme_surface_recent ,
                  loyer_moy_plai = .data$somme_loyer_nb_plai / .data$somme_surface_nb_plai ,
                  loyer_moy_pls = .data$somme_loyer_nb_pls / .data$somme_surface_nb_pls) %>%
    dplyr::select(-dplyr::starts_with("somme_"))

#  calcul du rang du loyer version numérqiue (rang_num) et caractère selon l'ordre croissant ou decroissant (rang_loy rang_loy_desc)
  loyers_rang <- loyers_0 %>%
    dplyr::filter(.data$reg_comp) %>%
    dplyr::select("Zone_ref", "loyer_moy") %>%
    dplyr::mutate(rang_num = rank(-.data$loyer_moy),
                  rang_loy = dplyr::case_when(
                    .data$rang_num == 1 ~ "",
                    TRUE ~ paste0(.data$rang_num, "e ")),
                  rang_num_desc = rank(.data$loyer_moy),
                  rang_loy_desc = dplyr::case_when(
                    .data$rang_num_desc == 1 ~ "",
                    TRUE ~ paste0(.data$rang_num_desc, "e "))) %>%
    dplyr::filter(.data$Zone_ref) %>%
    dplyr::select("rang_num", "rang_loy", "rang_loy_desc")

  loyers <- loyers_0 %>%
    dplyr::filter(.data$Zone_ref) %>%
    dplyr::select("TypeZone", dplyr::starts_with("loyer_moy")) %>%
    tidyr::pivot_wider(names_from = "TypeZone", values_from = dplyr::starts_with("loyer_moy")) %>%
    dplyr::mutate(dplyr::across(dplyr::everything(), format_fr_nb))


  # on récupère les formulations idiomatiques grâce à {propre.datareg}
  verb_reg <- propre.datareg::datareg(code_reg = id_reg)


  # on cree ensuite une liste nommee des differents parametres
  verb6 <- list(part_mes_plai_r = mises_svc$part_plai_R[1] %>% format_fr_pct,
                part_mes_plus_r = mises_svc$part_plus_R[1] %>% format_fr_pct,
                annee_prec = annee - 1,
                dans_la_region = verb_reg$dans_la_region,
                part_mes_plai_fr = mises_svc$part_plai_F[1] %>% format_fr_pct,
                comp_fr_mes_plai = ifelse(metro, "France m\u00e9tropolitaine", "France enti\u00e8re"),
                loyer_moy_r = loyers$loyer_moy_R,
                loyer_moy_fr = loyers$loyer_moy_F,
                reg_dep = verb_reg$la_region,
                reg_rang = dplyr::case_when(
                  metro & loyers_rang$rang_num <= 7 ~ paste0("la ", loyers_rang$rang_loy,"r\u00e9gion la plus ch\u00e8re de m\u00e9tropole"),
                  metro & loyers_rang$rang_num > 7 ~ paste0("la ", loyers_rang$rang_loy_desc,"r\u00e9gion la moins ch\u00e8re de m\u00e9tropole"),
                  !metro & loyers_rang$rang_num <=3 ~ paste0("le ", loyers_rang$rang_loy,"d\u00e9partement le plus cher d\u2019outre-mer"),
                  TRUE ~ paste0("le ", loyers_rang$rang_loy_desc,"d\u00e9partement le moins cher d\u2019outre-mer")),
                loy_moy_recent_r = loyers$loyer_moy_recent_R,
                comp_fr_loyer = ifelse(metro, "En France m\u00e9tropolitaine", "Sur l\'ensemble de la France"),
                loy_moy_recent_fr = loyers$loyer_moy_recent_F,
                comp_fr_loy_recent = ifelse(metro, "en France m\u00e9tropolitaine", "sur l\'ensemble de la France"),
                loyer_moy_plai_r = loyers$loyer_moy_plai_R,
                loyer_moy_pls_r = loyers$loyer_moy_pls_R,
                nom_plus_long = ifelse(metro, "PLUS (Pr\u00eat locatif \u00e0 usage social)",
                                       "LLS (Logement locatif social)"),
                nom_plai_long = ifelse(metro, "PLAI (pr\u00eat locatif aid\u00e9 d\u2019int\u00e9gration)",
                                       "LLTS (Logement locatif tr\u00e8s social)"),
                nom_plus_court = ifelse(metro, "PLUS", "LLS"),
                nom_plai_court = ifelse(metro, "PLAI", "LLTS")
                )


  # production du verbatim a partir des elements precedents
  verbatim_chap_6 <- list(intertitre ="", commentaires ="")
  verbatim_chap_6$intertitre <- glue::glue("{verb6$part_mes_plai_r} des mises en service \u00e0 destination des plus pr\u00e9caires")

  # paragraphe 1
  parag1 <- glue::glue("Le {verb6$nom_plus_long} finance {verb6$part_mes_plus_r} des logements mis en service en {verb6$annee_prec} {verb6$dans_la_region}.
      Le {verb6$nom_plai_long} finance des logements \u00e0 destination des publics les plus en difficult\u00e9s. Il a concern\u00e9
      {verb6$part_mes_plai_r} des mises en service en {verb6$annee_prec} {verb6$dans_la_region} "                       )
  if(verb6$part_mes_plai_r != verb6$part_mes_plai_fr){
    parag1 <- glue::glue(parag1, "contre {verb6$part_mes_plai_fr} en {verb6$comp_fr_mes_plai}.")
  } else {
    parag1 <- glue::glue(parag1, "comme {verb6$comp_fr_loy_recent}.")
  }

  # paragraphe 2
  parag2 <-  glue::glue(
    "Le loyer moyen s\u2019\u00e9l\u00e8ve \u00e0 {verb6$loyer_moy_r}\u202f\u20ac/m\u00b2 en {annee}, ce qui en fait {verb6$reg_rang}.
    {verb6$comp_fr_loyer}, le loyer moyen s\u2019affiche \u00e0 {verb6$loyer_moy_fr}\u202f\u20ac/m\u00b2."
    )

  # paragraphe 3
  parag3 <- "Dans le parc r\u00e9cent (mis en service depuis 5 ans ou moins), le loyer moyen s\u2019\u00e9tablit \u00e0
  {verb6$loy_moy_recent_r}\u202f\u20ac/m\u00b2 "
  if (verb6$loy_moy_recent_r != verb6$loy_moy_recent_fr){
    parag3 <- glue::glue(parag3, "contre {verb6$loy_moy_recent_fr}\u202f\u20ac/m\u00b2 {verb6$comp_fr_loy_recent}.")
  } else {
    parag3 <- glue::glue(parag3, "comme {verb6$comp_fr_loy_recent}.")
  }

  # paragraphe 4
  parag4 <- glue::glue(
  "Le loyer moyen est par ailleurs conditionn\u00e9 par le mode de financement initial.
  Il s\u2019affiche \u00e0 {verb6$loyer_moy_plai_r}\u202f\u20ac/m\u00b2 pour
  les logements financ\u00e9s par un {verb6$nom_plai_court} et {verb6$loyer_moy_pls_r}\u202f\u20ac/m\u00b2 pour ceux financ\u00e9s par un PLS."
  )


  verbatim_chap_6$commentaires <- glue::glue("{parag1}\n\n{parag2}\n\n{parag3}\n\n{parag4}")

  verbatim_chap_6
}

#' Phase de datapreparation pour la publication
#'
#' @description Consolidation des indicateurs aux differentes échelles et creation d'un champ de filtrage des territoires pour les illustrations.
#'
#' @param nom_reg Le nom de la region au format texte.
#' @param choix_epci Le parametre utilisateur de détail par epci au format texte : "1- Tous les EPCI de la zone" ou "2- Liste d EPCI à saisir".
#' @param epci_list Le vecteur des codes epci de reference, defini dans les parametres.
#' @param test TRUE si on souhaite tester dataprep() sur 100 communes choisies au hasard.
#'
#' @return Un dataframe d'indicateurs : une ligne par entite geographique et millesime, le champ Zone_ref permet de filtrer les territoires pour ne conserver que ceux a inclure dans les illustrations.
#' @importFrom COGiter cogifier ajouter_zonage
#' @importFrom dplyr select full_join mutate vars starts_with mutate filter case_when across pull group_by ungroup lag arrange
#' @importFrom forcats fct_relevel
#' @importFrom rlang .data
#' @importFrom tidyr replace_na expand_grid
#' @export
#'
#' @examples
#' \dontrun{
#' indicateurs_rpls <- dataprep(nom_reg = "Pays de la Loire", choix_epci ="2- Liste d EPCI a saisir",
#'                              epci_list = c("244400404", "244400644")) %>%
#'   dplyr::filter(Zone_ref)
#'   }
#'
dataprep <- function(nom_reg = "Pays de la Loire", choix_epci ="1- Tous les EPCI de la zone",  epci_list = NULL, test = FALSE) {

  if (test) {
    liste_depcom <- propre.rpls::tab_result %>%
      dplyr::pull("DEPCOM") %>%
      sample(size = 100)
    tab_result <- propre.rpls::tab_result %>%
      dplyr::filter(.data$DEPCOM %in% liste_depcom) %>%
      dplyr::mutate(millesime = factor(.data$millesime),
                    DEPCOM = factor(.data$DEPCOM))
    lgt_rp <- propre.rpls::lgt_rp %>%
      dplyr::filter(DEPCOM %in% liste_depcom)
  } else {
    liste_depcom <- COGiter::communes %>% dplyr::pull("DEPCOM")
    tab_result <- propre.rpls::tab_result %>%
      dplyr::mutate(millesime = factor(.data$millesime),
                    DEPCOM = factor(.data$DEPCOM))
    lgt_rp <- propre.rpls::lgt_rp
  }

  id_reg <- propre.rpls::get_id_reg(nom_reg)

  epci_choisis <- propre.rpls::select_epci(nom_reg, choix_epci, epci_list)

  communes_departement_a_garder <- COGiter::liste_zone %>%
    dplyr::filter(.data$TypeZone %in% c("Communes","D\u00e9partements"), grepl(id_reg, as.character(.data$REG))) %>%
    mutate(CodeZone = as.character(.data$CodeZone)) %>%
    pull("CodeZone") %>%
    as.character()

  # Ajout des zonages spé à l'Ile de France et AURA
  if(id_reg %in% c("11", "84")){
    communes_departement_a_garder <- dplyr::filter(propre.rpls::zonage_spe, as.character(.data$REG) == id_reg) %>%
      pull("CodeZone") %>%
      unique() %>%
      as.character() %>%
      c(., communes_departement_a_garder) %>%
      # On retire le departement du Rhone
      setdiff(., "69")
  }

  mil_disp <- dplyr::select(tab_result, "millesime") %>%
    dplyr::pull("millesime") %>%
    unique()
  # Le df de départ, une ligne par commune à jour et millésime
  df <- tidyr::expand_grid(DEPCOM = liste_depcom, millesime = mil_disp)

  # un df intermediaire pour pouvoir calculer les indicateurs de densite LS / RP pour toutes les annees
  # (on duplique les données du RP pour chaque millesime disponible)
  lgt_rp_mil <- dplyr::full_join(df, lgt_rp, by = "DEPCOM") %>%
    dplyr::select(-"mil_RP", -"mil_RP_old", -"nb_an_evol_rp")
  # une variable globale pour le nb d'annees d'ecart entre les mil du RP les plus récents pour le calcul des evolutions comparées RP/RPLS dans un dplyr::lag
  ecart_an_rp <- lgt_rp$nb_an_evol_rp[1]

  # etape de construction du résultat :
  # 1 - pour les indicateurs non sommables, on recalcule les composantes sommables
  # 2 - pour les indicateurs à NA, on complète à 0
  # 3 - passage des données tab_result sur le COG 2020
  # 4 - fusion avec le fichier rp complet sur la liste des communes
  # 5 - pour les communes non présentes dans tab_result, on met les indicateurs à 0
  # 6 - cogification
  # 7 - filtrage des données sur la région
  # 8 - calcul des indicatrices pertinentes pour filtrer les données ensuite : Zone_ref et select_prov_drom
  # 9 - recalcule des indicateurs non sommables
  # 10 - suppression des variables non nécessaires
  res <- tab_result %>%
    dplyr::mutate(dplyr::across(where(is.numeric), ~ tidyr::replace_na(., 0))) %>%
    COGiter::passer_au_cog_a_jour(garder_info_supra = FALSE) %>%
    dplyr::full_join(lgt_rp_mil, by = c("DEPCOM", "millesime")) %>%
    dplyr::mutate(dplyr::across(where(is.numeric), ~ tidyr::replace_na(., 0))) %>%
    COGiter::cogifier(
      communes = TRUE, epci = TRUE, departements = TRUE, regions = TRUE,
      metro = TRUE, metrodrom = TRUE, franceprovince = TRUE, drom = TRUE) %>%
    COGiter::ajouter_zonage(zonage_df = propre.rpls::zonage_spe %>% dplyr::select(-"REG")) %>%
    dplyr::filter(!(TypeZone %in% c("Communes","D\u00e9partements", "EPT")) | CodeZone %in% communes_departement_a_garder)  %>%
    dplyr::mutate(
      Zone_ref = dplyr::case_when(
        .data$TypeZone == "R\u00e9gions" & .data$CodeZone == id_reg ~ TRUE,
        .data$TypeZone == "D\u00e9partements" ~ TRUE,
        .data$TypeZone == "France" ~ TRUE,
        .data$TypeZone == "EPT" ~ TRUE,
        .data$CodeZone %in% epci_choisis ~ TRUE,
        TRUE ~ FALSE),
      select_prov_drom = dplyr::case_when(
        id_reg %in% paste0("0", 1:6) & .data$CodeZone %in% c("FRMETRO", "FRPROV") ~ FALSE,
        id_reg %in% paste0("0", 1:6) & .data$TypeZone == "D\u00e9partements" ~ FALSE,
        !(id_reg %in% paste0("0", 1:6)) & .data$CodeZone %in% c("DROM", "FRMETRODROM") ~ FALSE,
        TRUE ~ TRUE),
      TypeZone = forcats::fct_relevel(.data$TypeZone, "Communes", "Epci", "EPT", "D\u00e9partements", "R\u00e9gions", "France"),
      # Mettre au bon endroit les levels ajoutes avec ajouter_zonage
      CodeZone = forcats::fct_relevel(.data$CodeZone, sort)
    ) %>%
    dplyr::filter(.data$select_prov_drom) %>%
    dplyr::arrange(.data$TypeZone,.data$Zone,.data$CodeZone,.data$Zone_ref,.data$select_prov_drom,.data$millesime) %>%
    dplyr::group_by(.data$TypeZone,.data$Zone,.data$CodeZone,.data$Zone_ref,.data$select_prov_drom)
  res2 <- res %>%
    # reconstitution des variables intensives
    dplyr::mutate(
      age_moyen =  .data$age_somme / .data$nb_ls_age_connu,
      age_moyen_qpv = .data$age_somme_qpv / .data$nb_ls_qpv_age_connu,
      part_dpe_realise = .data$nb_ls_dpe_realise / .data$nb_ls_actif * 100,
      age_dpe_ener_A = .data$age_somme_dpe_ener_A / .data$nb_ls_age_connu_dpe_ener_A * 100,
      age_dpe_ener_B = .data$age_somme_dpe_ener_B / .data$nb_ls_age_connu_dpe_ener_B * 100,
      age_dpe_ener_C = .data$age_somme_dpe_ener_C / .data$nb_ls_age_connu_dpe_ener_C * 100,
      age_dpe_ener_D = .data$age_somme_dpe_ener_D / .data$nb_ls_age_connu_dpe_ener_D * 100,
      age_dpe_ener_E = .data$age_somme_dpe_ener_E / .data$nb_ls_age_connu_dpe_ener_E * 100,
      age_dpe_ener_F = .data$age_somme_dpe_ener_F / .data$nb_ls_age_connu_dpe_ener_F * 100,
      age_dpe_ener_G = .data$age_somme_dpe_ener_G / .data$nb_ls_age_connu_dpe_ener_G * 100,
      age_dpe_ener_new_A = .data$age_somme_dpe_ener_new_A / .data$nb_ls_age_connu_dpe_ener_new_A * 100,
      age_dpe_ener_new_B = .data$age_somme_dpe_ener_new_B / .data$nb_ls_age_connu_dpe_ener_new_B * 100,
      age_dpe_ener_new_C = .data$age_somme_dpe_ener_new_C / .data$nb_ls_age_connu_dpe_ener_new_C * 100,
      age_dpe_ener_new_D = .data$age_somme_dpe_ener_new_D / .data$nb_ls_age_connu_dpe_ener_new_D * 100,
      age_dpe_ener_new_E = .data$age_somme_dpe_ener_new_E / .data$nb_ls_age_connu_dpe_ener_new_E * 100,
      age_dpe_ener_new_F = .data$age_somme_dpe_ener_new_F / .data$nb_ls_age_connu_dpe_ener_new_F * 100,
      age_dpe_ener_new_G = .data$age_somme_dpe_ener_new_G / .data$nb_ls_age_connu_dpe_ener_new_G * 100,
      densite_ls_rp = .data$nb_ls_actif * 100 / .data$nb_rp,
      densite_ls_loues_rp = .data$nb_ls_loue * 100 / .data$nb_rp,
      evolution_rp =  (.data$nb_rp - .data$nb_rp_old) * 100 / .data$nb_rp_old,
      evolution_n_nmoins1 =  (.data$nb_ls_actif - dplyr::lag(.data$nb_ls_actif)) * 100 / dplyr::lag(.data$nb_ls_actif),
      evolution_annees_rp = (.data$nb_ls_actif - dplyr::lag(.data$nb_ls_actif, ecart_an_rp)) * 100 / dplyr::lag(.data$nb_ls_actif, ecart_an_rp),
      nb_ls_recent = .data$nb_piece_1_recent + .data$nb_piece_2_recent + .data$nb_piece_3_recent + .data$nb_piece_4_recent + .data$nb_piece_5_plus_recent,
      part_ls_qpv = .data$nb_ls_qpv / .data$nb_ls_actif * 100,
      part_ls_ind = .data$nb_ls_ind / .data$nb_ls_actif * 100,
      part_ls_coll = .data$nb_ls_coll / .data$nb_ls_actif * 100,
      part_ls_etu = .data$nb_ls_etu / .data$nb_ls_actif * 100,
      part_ls_oph = .data$nb_ls_oph / .data$nb_ls_actif * 100,
      part_ls_esh = .data$nb_ls_esh / .data$nb_ls_actif * 100,
      part_ls_sem = .data$nb_ls_sem / .data$nb_ls_actif * 100,
      part_ls_loue = .data$nb_ls_loue / .data$nb_ls_actif * 100,
      part_ls_vacant = .data$nb_ls_vacant / .data$nb_ls_actif * 100,
      part_ls_vide = .data$nb_ls_vide / .data$nb_ls_actif * 100,
      part_ls_association = .data$nb_ls_association / .data$nb_ls_actif * 100,
      part_ls_autre = .data$nb_ls_autre / .data$nb_ls_actif * 100,
      part_ls_recent =  .data$nb_ls_recent / .data$nb_ls_actif * 100,
      part_ls_ind_recent = .data$nb_ls_ind_recent / .data$nb_ls_recent * 100,
      part_ls_coll_recent = .data$nb_ls_coll_recent / .data$nb_ls_recent * 100,
      part_ls_etu_recent =  .data$nb_ls_etu_recent / .data$nb_ls_recent * 100,
      part_ls_qpv_ind = .data$nb_ls_ind_qpv / .data$nb_ls_qpv * 100,
      part_ls_qpv_coll = .data$nb_ls_coll_qpv / .data$nb_ls_qpv * 100,
      part_ls_qpv_etu = .data$nb_ls_etu_qpv / .data$nb_ls_qpv * 100,
      part_ls_1p = .data$nb_piece_1 / .data$nb_ls_actif * 100,
      part_ls_recent_1p = .data$nb_piece_1_recent / .data$nb_ls_recent * 100,
      part_ls_2p = .data$nb_piece_2 / .data$nb_ls_actif * 100,
      part_ls_recent_2p = .data$nb_piece_2_recent / .data$nb_ls_recent * 100,
      part_ls_3p = .data$nb_piece_3 / .data$nb_ls_actif * 100,
      part_ls_recent_3p = .data$nb_piece_3_recent / .data$nb_ls_recent * 100,
      part_ls_4p = .data$nb_piece_4 / .data$nb_ls_actif * 100,
      part_ls_recent_4p = .data$nb_piece_4_recent / .data$nb_ls_recent * 100,
      part_ls_5pp = .data$nb_piece_5_plus / .data$nb_ls_actif * 100,
      part_ls_recent_5pp = .data$nb_piece_5_plus_recent / .data$nb_ls_recent * 100,
      part_mes_qpv = .data$nb_mes_qpv / .data$nb_mes * 100,
      part_ls_age_0_4 = .data$nb_ls_age_0_5 / .data$nb_ls_actif * 100,
      part_ls_age_5_9 = .data$nb_ls_age_5_10 / .data$nb_ls_actif * 100,
      part_ls_age_10_19 = .data$nb_ls_age_10_20 / .data$nb_ls_actif * 100,
      part_ls_age_20_39 = .data$nb_ls_age_20_40 / .data$nb_ls_actif * 100,
      part_ls_age_40_59 = .data$nb_ls_age_40_60 / .data$nb_ls_actif * 100,
      part_ls_age_60p = .data$nb_ls_age_60_plus / .data$nb_ls_actif * 100,
      nb_ls_loues_proploc =  .data$nb_ls_loue + .data$nb_ls_vacant,
      taux_vacance_tot = .data$nb_ls_vacant / .data$nb_ls_loues_proploc * 100,
      taux_vacance_str = .data$nb_ls_vacant_3 / .data$nb_ls_loues_proploc * 100,
      taux_mobilite = .data$num_mob / .data$denom_mob *100,
      taux_mobilite_1p = .data$num_mob_1_piece / .data$denom_mob_1_piece *100,
      taux_mobilite_2p = .data$num_mob_2_piece / .data$denom_mob_2_piece *100,
      taux_mobilite_3p = .data$num_mob_3_piece / .data$denom_mob_3_piece *100,
      taux_mobilite_4p = .data$num_mob_4_piece / .data$denom_mob_4_piece *100,
      taux_mobilite_5pp = .data$num_mob_5_piece / .data$denom_mob_5_piece *100,
      taux_vacance_str_0_4ans = .data$num_vac_struct_age_0_5 / .data$denom_vac_struct_age_0_5 * 100,
      taux_vacance_str_5_9ans = .data$num_vac_struct_age_5_10 / .data$denom_vac_struct_age_5_10 * 100,
      taux_vacance_str_10_19ans = .data$num_vac_struct_age_10_20 / .data$denom_vac_struct_age_10_20 * 100,
      taux_vacance_str_20_39ans = .data$num_vac_struct_age_20_40 / .data$denom_vac_struct_age_20_40 * 100,
      taux_vacance_str_40_59ans = .data$num_vac_struct_age_40_60 / .data$denom_vac_struct_age_40_60 * 100,
      taux_vacance_str_60ans_plus = .data$num_vac_struct_age_60_plus / .data$denom_vac_struct_age_60_plus * 100,
      taux_vacance_str_qpv = .data$num_vac_struct_qpv / .data$denom_vac_struct_qpv * 100,
      taux_vacance_str_hors_qpv = .data$num_vac_struct_horsqpv / .data$denom_vac_struct_horsqpv * 100,
      part_mes_plai = .data$nb_plai / .data$nb_mes * 100,
      part_mes_plus = .data$nb_plus / .data$nb_mes * 100,
      part_mes_pls = .data$nb_pls / .data$nb_mes * 100,
      part_mes_pli = .data$nb_pli / .data$nb_mes * 100,
      loyer_m2_plai = .data$somme_loyer_nb_plai / .data$somme_surface_nb_plai,
      loyer_m2_plus = .data$somme_loyer_nb_plus / .data$somme_surface_nb_plus,
      loyer_m2_pls = .data$somme_loyer_nb_pls / .data$somme_surface_nb_pls,
      loyer_m2_pli = .data$somme_loyer_nb_pli / .data$somme_surface_nb_pli,
      loyer_m2_plai_recent = .data$somme_loyer_nb_plai_recent / .data$somme_surface_nb_plai_recent,
      loyer_m2_plus_recent = .data$somme_loyer_nb_plus_recent / .data$somme_surface_nb_plus_recent,
      loyer_m2_pls_recent = .data$somme_loyer_nb_pls_recent / .data$somme_surface_nb_pls_recent,
      loyer_m2_pli_recent = .data$somme_loyer_nb_pli_recent / .data$somme_surface_nb_pli_recent,
      loyer_m2_plai_mes = .data$somme_loyer_nb_plai_mes / .data$somme_surface_nb_plai_mes,
      loyer_m2_plus_mes = .data$somme_loyer_nb_plus_mes / .data$somme_surface_nb_plus_mes,
      loyer_m2_pls_mes = .data$somme_loyer_nb_pls_mes / .data$somme_surface_nb_pls_mes,
      loyer_m2_pli_mes = .data$somme_loyer_nb_pli_mes / .data$somme_surface_nb_pli_mes,
      loyer_m2 = .data$somme_loyer / .data$somme_surface,
      loyer_m2_recent = .data$somme_loyer_recent / .data$somme_surface_recent,
      loyer_m2_qpv = .data$somme_loyer_enqpv / .data$somme_surface_enqpv,
      loyer_m2_mes = (.data$somme_loyer_nb_plai_mes + .data$somme_loyer_nb_plus_mes + .data$somme_loyer_nb_pls_mes + .data$somme_loyer_nb_pli_mes ) /
        (.data$somme_surface_nb_plai_mes + .data$somme_surface_nb_plus_mes + .data$somme_surface_nb_pls_mes + .data$somme_surface_nb_pli_mes),
      loyer_m2_0_4ans = .data$somme_loyer_age_inf_5 / .data$somme_surface_age_inf_5,
      loyer_m2_5_9ans = .data$somme_loyer_age_5_10 / .data$somme_surface_age_5_10,
      loyer_m2_10_19ans = .data$somme_loyer_age_10_20 / .data$somme_surface_age_10_20,
      loyer_m2_20_39ans = .data$somme_loyer_age_20_40 / .data$somme_surface_age_20_40,
      loyer_m2_40_59ans = .data$somme_loyer_age_40_60 / .data$somme_surface_age_40_60,
      loyer_m2_60ans_et_plus = .data$somme_loyer_age_60_plus / .data$somme_surface_age_60_plus,
      part_mes_qpv_plai = .data$nb_mes_plai_qpv / .data$nb_mes_qpv * 100,
      part_mes_qpv_plus = .data$nb_mes_plus_qpv / .data$nb_mes_qpv * 100,
      part_mes_qpv_pls = .data$nb_mes_pls_qpv / .data$nb_mes_qpv * 100,
      part_mes_qpv_pli = .data$nb_mes_pli_qpv / .data$nb_mes_qpv * 100,
      part_plai_acq_av_travaux = .data$nb_plai_acq_av_travaux / .data$nb_plai * 100,
      part_plai_acq_ss_travaux = .data$nb_plai_acq_ss_travaux / .data$nb_plai * 100,
      part_plai_acq_vefa = .data$nb_plai_acq_vefa / .data$nb_plai * 100,
      part_plai_construit_org = .data$nb_plai_construit_org / .data$nb_plai * 100
    ) %>%
    dplyr::ungroup() %>%
    dplyr::select(-"select_prov_drom")

  return(res2)

}



#' Trouve les chemins des fichiers du package propre.rpls
#'
#' Renvoie les adresses absolues des fichiers presents dans le repertoire d'installation du package a partir de leur adresse relative.
#' @param ... Une ou plusieurs chaines de caracteres, representant les noms de fichiers ou repertoires a rechercher dans le package.
#' @return  Un chemin absolu.
#' @examples
#' propre.rpls_file('rstudio', 'templates', 'project', 'ressources')
#'
#' @export
propre.rpls_file <- function(...) {
  system.file(..., package = 'propre.rpls', mustWork = TRUE)
}


#' Fonction de creation du repertoire du projet de l'utilisateur
#'
#' A partir de la saisie des parametres par l'utilisateur, cette fonction peuple le repertoire de travail de l'utilisateur avec
#' le bookdown et fixe les parametres yaml dans `index.Rmd`.
#'
#' @param path Repertoire du projet de publication saisi par l'utilisateur.
#' @param ... Autres parametres saisis par l'utilisateur (region, epci, millesime).
#' @return TRUE
#' @examples
#' \dontrun{
#'  propre.rpls_skeleton("rpls2019bretagne", annee="2019",
#'                        epci_ref="1- Tous les EPCI de la zone", nom_region="Bretagne")
#' }
#'
#' @importFrom xfun read_utf8 write_utf8
#' @importFrom propre.datareg datareg
#' @export
propre.rpls_skeleton <- function(path,...) {

  # bloquer la creation si projet existant
  if(file.exists(path)) {
    message(paste0("le dossier '", path, "' existe deja\nveuillez le supprimer ou changer de nom de dossier\nRstudio ouvre l'ancien projet"))
  }

  else {

    # Creer le repertoire de travail
    dir.create(path, recursive = TRUE, showWarnings = FALSE)
    dir.create(file.path(path, "extdata"), showWarnings = FALSE)
    dir.create(file.path(path, "www"), showWarnings = FALSE)
    # Copier le dossier 'resources' vers le repertoire de travail utilisateur
    resources <- propre.rpls_file('rstudio', 'templates', 'project', 'ressources')

    files <- list.files(resources, recursive = FALSE, include.dirs = FALSE)

    source <- file.path(resources, files)
    target <- file.path(path, files)
    file.copy(source, target)

    # Copier le dossier 'resources/extdata' vers le repertoire de travail utilisateur
    res_data <- propre.rpls_file('rstudio', 'templates', 'project', 'ressources', 'extdata')
    data_files <- list.files(res_data, recursive = FALSE, include.dirs = FALSE)
    source <- file.path(res_data, data_files)
    target <- file.path(path, "extdata", data_files)
    file.copy(source, target)


    # Ajouter le nom du projet utilisateur en tant que titre du bookdown dans _bookdown.yml
    f <- file.path(path, '_bookdown.yml')
    x <- xfun::read_utf8(f)
    xfun::write_utf8(c(sprintf('book_filename: "%s"', basename(path)), x), f)


    # Collecter les inputs utilisateurs et les assembler comme \"parametre: valeur"
    dots <- list(...)

    text <- lapply(seq_along(dots), function(i) {
      key <- names(dots)[[i]]
      val <- dots[[i]]
      paste0("  ", key, ": ", "\"",val, "\"")
    })

    # Gérer les types d analyses par epci en proposant une liste d'EPCI à adapter si choix 2

    if(grepl("2- ", dots$epci_ref)) {
      list_epci <- "  epci_list: !r c(\"244400404\",\"244400644\",\"244900015\",\"245300330\",\"247200132\",\"248500589\",\"200071678\",\"200071876\",\"244400610\",\"200071165\")"
    } else {
      list_epci <- "  "
    }

    # Assembler les parametres collectes dans une unique chaine de caracteres et declarer son encodage
    contents <- paste("params:",
                      paste(text, collapse = "\n"),
                      list_epci, sep = "\n")
    Encoding(contents) <- "UTF-8"


    # Injecter les parametres dans le fichier index.Rmd
    conn <- file.path(path,"index.Rmd")
    text <- xfun::read_utf8(conn)
    mytext <- c(text[1:8],contents,text[(8+1):length(text)])
    xfun::write_utf8(mytext, conn, sep="\n")

    # Injecter le logo
    reg <- dots$nom_region
    id_reg <- get_id_reg(nom_reg = reg)
    logo <- paste0("prefecture_r", id_reg)
    logo_file_path <- gouvdown::logo_file_path(logo)
    file_ext <- xfun::file_ext(logo_file_path)
    target_file <- paste("logo",file_ext,sep=".")
    target <- file.path(path, "www", target_file)
    file.copy(logo_file_path, target)
    content <- sprintf('        <li><a href="./"><img src="www/%s" width = "130"></a></li>', target_file)
    f <- file.path(path, "_output.yml")
    x <- xfun::read_utf8(f)
    output <- c(x[1:5], content, x[6:length(x)])
    xfun::write_utf8(output, f)

    # Injecter les css
    css_dir <- system.file("resources", "css", package = "gouvdown", mustWork = TRUE)
    css_files <- list.files(css_dir)
    source <- file.path(css_dir, css_files)
    target <- file.path(path, css_files)
    file.copy(source, target)

    # Injecter le mail de contact, le titre millésimé et la région de publication dans _output.yml
    mail <- propre.datareg::datareg(code_reg = id_reg)$courriel_contact
    complmt_reg <- propre.datareg::datareg(code_reg = id_reg)$en_de_nom_region
    f <- file.path(path, '_output.yml')
    x <- xfun::read_utf8(f)
    contents <- sprintf("         <li><a href='./'>Le parc social en %s</a></li>", dots[[1]]) # dots sont les paramètres utilisateurs, le premier est le millesime
    x[9] <- gsub("mailto:", paste0("mailto:", mail, "?Publication RPLS ", dots[[1]]), x[9])
    output <- c(x[1:6], contents, x[(5+3):length(x)])
    xfun::write_utf8(output, f)

    TRUE
  }
}

#' @title Chapitre 5 : Verbatim
#'
#' @description Production des commentaires verbatim du chapitre 5.
#'
#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref
#' @param annee Le millésime renseigné par l'utilisateur (au format numérique)
#'
#' @return Un vecteur de 2 chaînes de caractères comprenant l'intertitre et les commentaires essentiels du chapitre 5
#'
#' @importFrom dplyr across filter pull mutate select arrange summarise first last case_when
#' @importFrom glue glue
#' @importFrom propre.datareg datareg maj1let
#' @importFrom tidyr pivot_wider
#' @importFrom rlang .data
#'
#' @export
#'
#' @examples
#' indic_rpls_ref <- propre.rpls::lire_rpls_exemple() %>%
#'  dplyr::filter(Zone_ref)
#'
#' creer_verbatim_5(data = indic_rpls_ref, annee = 2019)[["intertitre"]]
#' creer_verbatim_5(data = indic_rpls_ref, annee = 2019)[["commentaires"]]


creer_verbatim_5 <- function(data, annee) {

  # calcul annee de depart des evolutions
  annee_old <- annee - 4

  # Récupération des formulations idiomatiques grâce à {propre.datareg} et autres info sur la region etudiee
  id_reg <- dplyr::filter(data, grepl("gions", .data$TypeZone)) %>%
    dplyr::pull("CodeZone") %>%
    unique() %>% as.character()
  verb_reg <- propre.datareg::datareg(code_reg = id_reg)
  reg_om <- (id_reg %in% paste0("0", 1:6))

  # Création de la table avec tous les indicateurs calculés
  vac_mob_0 <- data %>%
    # Filtre pour ne conserver que les données de l'année choisie, de la région choisie et de la maille nationale (FRMETRO ou FRMETRODROM)
    dplyr::filter(.data$millesime %in% c(annee, annee_old), grepl("gions", .data$TypeZone) | grepl("FRMETRO", .data$CodeZone)) %>%
    # Création de variables utiles, notamment indicateurs calculés
    dplyr::mutate(TypeZone = substr(.data$TypeZone, 1, 1),
                  taux_vac = .data$taux_vacance_tot,
                  taux_vac_3 = .data$taux_vacance_str,
                  taux_mob = .data$taux_mobilite) %>%
    # sélection des variables utiles
    dplyr::select("TypeZone", "millesime", "nb_ls_loues_proploc", "nb_ls_vacant",
                  "taux_vac", "nb_ls_vacant_3", "taux_vac_3", "taux_mob")

  vac_mob <- dplyr::filter(vac_mob_0, .data$millesime == annee) %>%
    # Passage du format long au format large
    tidyr::pivot_wider(names_from = "TypeZone", values_from = c("nb_ls_loues_proploc", "nb_ls_vacant", "taux_vac",
                                                                "nb_ls_vacant_3", "taux_vac_3", "taux_mob")) %>%
    # Création des variables relatives aux noms des mailles régionale (nom région) et nationale (FRMETRO ou FRMETRODROM)
    dplyr::mutate(nomzone = ifelse(reg_om, "sur l\u2019ensemble de la France", "en France m\u00e9tropolitaine"))

  evol_vac_mob <- vac_mob_0 %>%
    dplyr::filter(.data$TypeZone == "R") %>%
    dplyr::arrange(.data$millesime) %>%
    dplyr::summarise(
      taux_mob_r_old = dplyr::first(.data$taux_mob) %>% round(1),
      taux_mob_r_actu = dplyr::last(.data$taux_mob) %>% round(1),
      taux_vac_3_r_old = dplyr::first(.data$taux_vac_3) %>% round(1),
      taux_vac_3_r_actu = dplyr::last(.data$taux_vac_3) %>% round(1),
    ) %>%
    dplyr::mutate(
      ecart_mob = .data$taux_mob_r_actu - .data$taux_mob_r_old,
      ecart_vac3 = .data$taux_vac_3_r_actu - .data$taux_vac_3_r_old,
      dplyr::across(.cols = c("ecart_mob", "ecart_vac3"), .names = "{.col}_fmt",
                    .fns = ~ paste0( "de ", format_fr_nb(x = abs(.x), dec = 1), " point")),
      verb_mob = dplyr::case_when(.data$ecart_mob < 0 ~ glue::glue("a baiss\u00e9 {.data$ecart_mob_fmt}"),
                                  .data$ecart_mob == 0 ~ "est rest\u00e9e stable",
                                  .data$ecart_mob > 0 ~ glue::glue("a progress\u00e9 {.data$ecart_mob_fmt}")),
      verb_vac3 = dplyr::case_when(.data$ecart_vac3 < 0 ~ glue::glue("a diminu\u00e9 {.data$ecart_vac3_fmt}"),
                                   .data$ecart_vac3 > 0 ~ glue::glue("a augment\u00e9 {.data$ecart_vac3_fmt}"),
                                   .data$ecart_vac3 == 0 ~ "est rest\u00e9e stable")) %>%
    dplyr::mutate(verb_mob = ifelse(abs(.data$ecart_mob) > 1, paste0(.data$verb_mob, "s"), .data$verb_mob),
                  verb_vac3 = ifelse(abs(.data$ecart_vac3) > 1, paste0(.data$verb_vac3, "s"), .data$verb_vac3))



  # Création de liste avec tous les paramètres utiles au commentaire
  verb5 <- list(nb_vac_reg = vac_mob$nb_ls_vacant_R %>% format_fr_nb(dec = 0),
                nb_vac_3_reg = vac_mob$nb_ls_vacant_3_R %>% format_fr_nb(dec = 0),
                annee = annee,
                nb_ls_loues_proploc_reg = vac_mob$nb_ls_loues_proploc_R %>% format_fr_nb(dec = 0),
                region = verb_reg$dans_la_region_nom_region,
                taux_vac_reg = vac_mob$taux_vac_R %>% format_fr_pct,
                taux_vac_fr = vac_mob$taux_vac_F %>% format_fr_pct,
                france = vac_mob$nomzone,
                taux_vac_3_reg = vac_mob$taux_vac_3_R %>% format_fr_pct,
                taux_vac_3_fr = vac_mob$taux_vac_3_F %>% format_fr_pct,
                evol_vac3 = evol_vac_mob$verb_vac3,
                annee_old = annee - 4,
                annee_moins1 = annee - 1,
                taux_mob_reg = vac_mob$taux_mob_R %>% format_fr_pct,
                taux_mob_fr = vac_mob$taux_mob_F %>% format_fr_pct,
                evol_mob = evol_vac_mob$verb_mob,
                loc_intertitre = verb_reg$dans_la_region)


  # Production du verbatim
  verbatim_chap_5 <- list(intertitre ="", commentaires ="")

  verbatim_chap_5$intertitre <- if (verb5$nb_vac_reg == "0") {
    glue::glue("Au 1er janvier ", {verb5$annee}, ", aucun logement social n\'est vacant {verb5$loc_intertitre}.")
  } else {
    glue::glue("{propre.datareg::maj1let(verb5$loc_intertitre)}, {verb5$nb_vac_reg} logements sont vacants et ",
               "{verb5$nb_vac_3_reg} le sont depuis plus de trois mois.")
  }

  #phrase 1
  phrase1 <- "Au 1er janvier {verb5$annee}, parmi les {verb5$nb_ls_loues_proploc_reg} logements lou\u00e9s ou propos\u00e9s \u00e0 la location {verb5$region}, "
  if (verb5$nb_vac_reg == "0"){
    phrase1 <- glue::glue(phrase1, "aucun n\'est vacant, contre {verb5$taux_vac_fr} {verb5$france}.")
  } else if (verb5$taux_vac_reg != verb5$taux_vac_fr) {
    phrase1 <- glue::glue(phrase1, "{verb5$taux_vac_reg} sont vacants, contre {verb5$taux_vac_fr} {verb5$france}.")
  } else {
    phrase1 <- glue::glue(phrase1, "{verb5$taux_vac_reg} sont vacants, comme {verb5$france}.")
  }

  #phrase 2
  phrase2 <- " La vacance de plus de trois mois, dite \u00ab vacance structurelle \u00bb est de {verb5$taux_vac_3_reg}, "
  if (verb5$nb_vac_reg == "0"){
    phrase2 <- glue::glue("")
  } else if (verb5$taux_vac_3_reg != verb5$taux_vac_3_fr) {
    phrase2 <- glue::glue(phrase2, "contre {verb5$taux_vac_3_fr} au niveau national. ")
  } else {
    phrase2 <- glue::glue(phrase2, "comme au niveau national. ")
  }

  #phrase 3
  phrase3 <- glue::glue("Elle {verb5$evol_vac3} entre {verb5$annee_old} et {verb5$annee}. ")

  #phrase 4
  phrase4 <- "En {verb5$annee_moins1}, {verb5$taux_mob_reg} de logements ont chang\u00e9 de locataires, "
  if (verb5$taux_mob_reg != verb5$taux_mob_fr){
    phrase4 <- glue::glue(phrase4, "contre {verb5$taux_mob_fr} {verb5$france}. ")
  } else {
    phrase4 <- glue::glue(phrase4, "comme {verb5$france}. ")
  }

  #phrase 5
  phrase5 <- glue::glue("La mobilit\u00e9 {verb5$evol_mob} entre {verb5$annee_old} et {verb5$annee}. ")


  # Renvoi du résultat
  verbatim_chap_5$commentaires <- glue::glue("{phrase1}{phrase2}{phrase3}\n\n{phrase4}{phrase5}")

  verbatim_chap_5

}

#' Ouvrir l'application de consultation des indicateurs complementaires
#' @param nom_reg Le nom de la région sur laquelle vous souhaitez que l'application se lance.
#' @param clean TRUE si vous voulez recalculer les données.
#' @importFrom rappdirs user_data_dir
#' @importFrom tidyr pivot_longer pivot_wider
#' @importFrom dplyr left_join mutate select bind_rows filter
#' @importFrom utils read.csv2
#' @return a shiny app
#' @export
#'

run_rpls_explorer <- function(nom_reg = "53 Bretagne", clean = FALSE) {

  df_path <- file.path(rappdirs::user_data_dir("propre.rpls"),"propre_rpls.RData")

  if (!file.exists(df_path) | clean) {

    if (!dir.exists(rappdirs::user_data_dir("propre.rpls"))) {dir.create(rappdirs::user_data_dir("propre.rpls"), recursive = TRUE)}

    liste_var_avec_libelle <- utils::read.csv2(propre.rpls::propre.rpls_file('rstudio/templates/project/ressources/extdata/dico_var.csv'), fileEncoding = "UTF-8")

    liste_var_avec_libelle_compl <- utils::read.csv2(propre.rpls::propre.rpls_file('rstudio/templates/project/ressources/extdata/dico_var_compl.csv'), fileEncoding = "UTF-8")

    liste_var_avec_libelle_rp <- utils::read.csv2(propre.rpls::propre.rpls_file('rstudio/templates/project/ressources/extdata/dico_var_rp.csv'), fileEncoding = "UTF-8") %>%
      # suppression des variables sur les millésimes du RP, qui ne figurent pas dans le resultat de dataprep()
      dplyr::filter(!(.data$nom_court %in% c("mil_RP", "mil_RP_old", "nb_an_evol_rp")))

    liste_var_avec_libelle <- dplyr::bind_rows(liste_var_avec_libelle, liste_var_avec_libelle_compl, liste_var_avec_libelle_rp) %>%
      dplyr::mutate(Chapitre = as.factor(.data$Chapitre))

    propre_rpls <- dataprep(nom_reg = nom_reg) %>%
      dplyr::filter((.data$TypeZone == "Communes" & .data$nb_logt_total > 0) | .data$TypeZone != "Communes") %>%
      tidyr::pivot_longer(cols = -c("TypeZone", "Zone", "Zone_ref", "CodeZone", "millesime"),
                          names_to = "nom_court", values_to = "valeur") %>%
      dplyr::left_join(liste_var_avec_libelle %>%
                         dplyr::select("nom_court", "libelles")) %>%
      dplyr::select(-"nom_court") %>%
      tidyr::pivot_wider(names_from = "libelles", values_from = "valeur")

    save(propre_rpls, liste_var_avec_libelle, file = df_path)
  }

  appDir <- system.file("shiny", package = "propre.rpls")

  if (appDir == "") {
    stop("Could not find app directory. Try re-installing `{propre.rpls}`.", call. = FALSE)
  }

  shiny::runApp(appDir, display.mode = "normal")
}

#' get_dataprep : recuperer les resultats de la precedente execution de la datapreparation
#'
#' Cette fonction evite de lancer plusieurs fois la fonction de preparation des données `dataprep()` en sauvegardant le resultat de son execution.
#' Cela pouvait s'averer fastidieux en cas de compilations repetees de la publication.
#' La datapreparation ne s'execute qu'en cas de 1ere execution ou de souhait de mise a jour des indicateurs
#' (utile si par exemple le package a evolue au niveau des donnees, ou si on change des parametres utilisateurs comme la liste des EPCI de reference, la region ou le millesime).
#'
#' @param maj Booleen pour indiquer si on souhaite mettre a jour les donnees en relancant la fonction de datapreparation.
#' @param par_util La liste des parametres utilisateurs de la publication (params).
#' @param test Booleen qui indique si on souhaite executer la version de test de datapreparation.
#' @param ext_dir Le repertoire d'export des donnees en RData, sera cree si inexistant. Par defaut le repertoire de travail courant.
#'
#' @return Un dataframe d'indicateurs : une ligne par entite geographique et millesime, le champ Zone_ref permet de filtrer les territoires pour ne conserver que ceux a inclure dans les illustrations.
#' @export
#'
#' @examples
#' get_dataprep(maj = FALSE, test = TRUE, ext_dir = tempdir(),
#'              par_util = list(nom_region = "Bretagne", epci_ref = "3- ", epci_list = NULL))
get_dataprep <- function(maj = FALSE, par_util = list(nom_region = "Bretagne", epci_ref = "3- ", epci_list = NULL),
                         test = FALSE, ext_dir = ".")  {
  dir.create(ext_dir, recursive = TRUE, showWarnings = FALSE)
  dataset <- "indicateurs_rpls"
  rdata <- paste0(ext_dir, "/", dataset, ".RData")

  if(file.exists(rdata) & !maj) {
    load(rdata)
    return(indicateurs_rpls)
  } else {
    df <- propre.rpls::dataprep(par_util$nom_region, choix_epci = par_util$epci_ref, epci_list = par_util$epci_list, test = test)
    assign(dataset, df)
    save("indicateurs_rpls", file = rdata)
    return(df)
  }
}

#' get_fond_carto : recuperer les resultats de la precedente execution de la preparation du fond carto
#'
#' Cette fonction evite de lancer plusieurs fois la fonction de preparation du fond carto `fond_carto()`, en exportant le resultat de son execution.
#' Cela pouvait s'averer fastidieux en cas de compilations repetees de la publication.
#' La preparation du fond carto ne s'execute qu'en cas de 1ere execution ou de souhait de mise a jour.
#'
#' @param maj Booleen pour indiquer si on souhaite mettre a jour les donnees en relancant la fonction de datapreparation.
#' @param par_util La liste des parametres utilisateurs de la publication (params).
#' @param ext_dir Le repertoire d'export des donnees en RData, sera cree si inexistant. Par defaut le repertoire de travail courant.
#' @param ... Autres parametres de la fonction  \code{mapfactory::\link{fond_carto}}.
#'
#' @return Le fond_carto, ie une liste de dataframes geographiques sf.
#' @export
#'
#' @examples
#' get_fond_carto(maj = FALSE, par_util = list(nom_region = "Bretagne"), ext_dir = tempdir())
get_fond_carto <- function(maj = FALSE, par_util = list(nom_region = "Bretagne"), ext_dir = ".", ...) {
  dir.create(ext_dir, recursive = TRUE, showWarnings = FALSE)
  dataset <- "fond_carto"
  rdata <- paste0(ext_dir, "/", dataset, ".RData")
  if(file.exists(rdata) & !maj) {
    load(rdata)
    return(fond_carto)
  } else {
    df <- mapfactory::fond_carto(par_util$nom_region, ...)
    assign(x = dataset, value = df)
    save("fond_carto", file = rdata)
    return(df)
  }
}


#' Creer la sortie pdf d une publication html
#' `r lifecycle::badge("experimental")`
#'
#' Permet de compiler le book (si celui-ci ne l a pas deja ete) et d en produire la sortie en pdf dans le repertoire du book.
#'
#' @param chemin_book Chemin du book html a convertir en pdf, vaut par defaut "_book/" (= repertoire de compilation de la publication par defaut). Le book sera compile si chemin_book n'existe pas.
#' @param nom_pdf Nom du fichier pdf a creer, par defaut "book_complet.pdf".
#' @param pages_html Vecteur des noms de chapitres du book html a integrer dans le fichier pdf, dans l'ordre souhaite. Par defaut c("index", "Chapo", "evolparc", "caractparc", "mouvmts", "dpe", "tension", "loyers", "methodo", "mentionslegales") ce qui correspond aux noms des pages html par defaut.
#' @param scale le facteur de mise a l'echelle, 0.9 par defaut
#'
#' @return file pdf
#'
#' @importFrom attempt stop_if_any
#' @importFrom glue glue
#' @importFrom pagedown chrome_print
#' @importFrom purrr map
#' @importFrom qpdf pdf_combine
#' @importFrom rmarkdown render_site
#' @export
#'
#' @examples
#' \dontrun{
#' creer_pdf_book()
#' }
creer_pdf_book <- function(chemin_book = "_book/", nom_pdf = "book_complet.pdf",
                           pages_html = c("index", "Chapo", "evolparc", "caractparc", "mouvmts", "dpe",
                                          "tension", "loyers", "methodo", "mentionslegales"),
                           scale = 0.9){

  if(!dir.exists(chemin_book)){
    # si le book n'existe pas encore
    message(glue::glue("Le repertoire {chemin_book} n'existe pas, creation au prealable de la publication au format html."))
    rmarkdown::render_site(encoding = 'UTF-8')
    chemin_book = "_book/"
  } else {
    # une precaution au cas où l'utilisateur oublierait le '/'
    chemin_book <- paste0(chemin_book, ("/"))
  }

  # liste des fichiers
  pages_html <- gsub(".html$", "", pages_html) # precaution : on enlève l'extension si l'utilisateur l'a saisie
  pages_html <- paste0(chemin_book, pages_html, ".html") # puis on la rajoute
  pages_pdf <- gsub(".html", ".pdf", pages_html)

  # verification de la presence de tous les fichiers html necessaire a la sortie pdf
  attempt::stop_if_any(!file.exists(pages_html),
                       msg = glue::glue("Il manque au moins un fichier html dans {chemin_book} ou il y a probleme de nommage, revoyez l'argument 'pages_html'."))

  # chrome_print ne fonctionne que si il a un fichier nomme style.css.
  file.copy(from = paste0(chemin_book, "gouv_book.css"), to = paste0(chemin_book, "style.css") )

  message("Export des pages html au format PDF en cours :")
  impress <- function(page, echelle = scale) {
    message(glue::glue("- {page}"))
    pagedown::chrome_print(input = page, extra_args = c('--disable-gpu', '--no-sandbox'), verbose = 0,
                           timeout = 600, options = list(transferMode = 'ReturnAsStream', scale = echelle))
  }
  purrr::map(.x = pages_html, .f = impress)


  #Compilation des pdf pour obtenir le book complet en pdf
  qpdf::pdf_combine(pages_pdf, output = glue::glue("{chemin_book}{nom_pdf}"))

  # suppresion des fichiers pdf crees separement et du fichier style.css
  file.remove(pages_pdf, glue::glue("{chemin_book}style.css"))
  suppressWarnings(file.remove(glue::glue("{chemin_book}404.pdf")))

  message(glue::glue("Le fichier {nom_pdf} est disponible dans {chemin_book}."))
}

#' Mentionne la ou les sources dans les illustrations.
#'
#' @param sources Un entier egal à 1 ou 2, 1 pour la source RPLS seule, 2 pour RPLS et RP INSEE
#' @param mil_rpls Une annee parmi les millesimes selectionnables par l'utilisateur, au format numerique.
#'
#' @return Une chaine de texte
#' @export
#'
#' @examples
#' caption(sources = 1, mil_rpls = 2018)
#'
#'

caption <- function(sources = 1, mil_rpls = 2020){

  lib_rpls <- paste0("SDES, RPLS au 1er janvier ", mil_rpls)
  lib_rp <- paste0("INSEE, recensement de la population ", lgt_rp$mil_RP[1])

  if(sources == 1) {
    lib <- paste0("Source : ", lib_rpls)
  }

  if(sources == 2) {
    lib <- paste0("Sources : ", lib_rpls, " ; ", lib_rp)
  }

  lib
}

#' Chapitre 2: Verbatim
#'
#' @description Production des commentaires verbatim du chapitre 2.

#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref
#' @param annee Le millesime renseigné par l'utilisateur (au format numérique)
#'
#' @return Un vecteur de 2 chaînes de caractères comprenant l'intertitre et les commentaires essentiels du chapitre 2
#'
#' @importFrom dplyr across case_when contains filter matches mutate pull select starts_with
#' @importFrom glue glue
#' @importFrom propre.datareg datareg maj1let
#' @importFrom rlang .data
#' @importFrom tidyr pivot_longer pivot_wider
#'
#' @export
#'
#' @examples
#' indic_rpls_ref <- propre.rpls::lire_rpls_exemple() %>%
#'  dplyr::filter(Zone_ref)
#'
#' creer_verbatim_2(data = indic_rpls_ref, annee = 2019)[["intertitre"]]
#' creer_verbatim_2(data = indic_rpls_ref, annee = 2019)[["commentaires"]]

creer_verbatim_2 <- function(data, annee) {
  # récupération du code région
  id_reg <- dplyr::filter(data, grepl("gions", .data$TypeZone)) %>%
    dplyr::pull("CodeZone") %>% unique() %>% as.character()

  # on calcule d'abord les indicateurs necessaires aux commentaires - table de donnees communes
  amorce <- data %>%
    # on garde : Fce metro si reg metropolitaine (CodeZone FRMETRO") ou Fce entiere si DROM (CodeZone FRMETRODROM) + FRPROV pour lgt etudiant en  idf
    dplyr::filter(.data$millesime == annee, grepl("gions", .data$TypeZone) | .data$CodeZone %in% c("FRPROV", "FRMETRO", "FRMETRODROM")) %>%
    dplyr::select("millesime", "CodeZone", "TypeZone", "nb_ls_actif",
                  "part_ls_ind", "part_ls_coll", # intertitre et commentaire §4
                  "nb_ls_loue","nb_ls_vacant","nb_ls_vide", "nb_ls_association","nb_ls_autre", # commentaire § 2
                  "nb_ls_etu", "part_ls_etu", # commentaire § 3
                  "partLs_oph" = "part_ls_oph", "partLs_esh" = "part_ls_esh", "partLs_sem" = "part_ls_sem", "nb_ls_autres_cat", # commentaire 1er §
                  dplyr::matches("^nb_piece_[[:digit:]].*"), "nb_ls_ind_recent", "nb_ls_recent", "part_ls_ind_recent" ) %>% # commentaire 4e §
    dplyr::mutate(TypeZone = substr(.data$TypeZone, 1, 1), # on simplifie le lib de niv geo pour limiter les soucis d'encodage
                  # commentaire 2e §
                  nb_ls_hors_marche = .data$nb_ls_vide + .data$nb_ls_association + .data$nb_ls_autre,
                  part_ls_hors_marche = 100 * .data$nb_ls_hors_marche / .data$nb_ls_actif,
                  # commentaire 1er §
                  partLs_autre = .data$nb_ls_autres_cat / .data$nb_ls_actif * 100,
                  # commentaire 5e §
                  part_1_2_pieces = 100 * (.data$nb_piece_1 + .data$nb_piece_2) / .data$nb_ls_actif,
                  part_1_2_pieces_recent = 100 * (.data$nb_piece_1_recent + .data$nb_piece_2_recent) / .data$nb_ls_recent,
                  part_5_pieces_et_plus = 100 * .data$nb_piece_5_plus / .data$nb_ls_actif,
                  part_5_pieces_et_plus_recent = 100 * .data$nb_piece_5_plus_recent / .data$nb_ls_recent,
                  dplyr::across(dplyr::starts_with("part_"), ~round(.x, 1)))

  ligne_reg <- dplyr::filter(amorce, .data$TypeZone == "R")

  # intertitre et 4e §
  indiv_coll <- amorce %>%
    dplyr::filter(.data$CodeZone != "FRPROV") %>%
    tidyr::pivot_wider(id_cols = "millesime", names_from = "TypeZone", values_from = c("part_ls_ind", "part_ls_coll")) %>%
    dplyr::mutate(
      ecart_part_indiv = .data$part_ls_ind_R - .data$part_ls_ind_F,
      dif_reg_fr_indiv_titre = dplyr::case_when(
        .data$ecart_part_indiv > 0 ~  "plus importante qu\u2019au",
        .data$ecart_part_indiv == 0 ~  "similaire au",
        .data$ecart_part_indiv  < 0 ~  "moindre qu\u2019au"),
      dif_reg_fr_indiv_com = dplyr::case_when(
        .data$ecart_part_indiv  > 0 ~  "cependant plus importante qu\u2019au",
        .data$ecart_part_indiv  == 0 ~  "similaire au",
        .data$ecart_part_indiv  < 0 ~  "m\u00eame moindre qu\u2019au"),
      com_part_ind_fr = dplyr::case_when(
        .data$ecart_part_indiv  == 0 ~  "",
        TRUE ~ .data$part_ls_ind_F %>% format_fr_pct() %>%  paste0(" (", ., ")")))

  # commentaire 1er § nature bailleurs
  type_bail <- ligne_reg %>%
    tidyr::pivot_longer(cols = starts_with("partLs_"), values_to = "part_type_bail", names_to = "type_bail_maj") %>%
    dplyr::filter(.data$part_type_bail == max(.data$part_type_bail)) %>%
    dplyr::select("type_bail_maj", "part_type_bail") %>%
    dplyr::mutate(
      type_bail_maj = dplyr::case_when(
        .data$type_bail_maj == "partLs_oph" ~ "organismes publics pour l\u2019habitat (OPH)",
        .data$type_bail_maj == "partLs_esh" ~ "entreprises sociales de l\u2019habitat (ESH)",
        .data$type_bail_maj == "partLs_sem" ~ "soci\u00e9t\u00e9 d\u2019\u00e9conomie mixte (SEM)",
        TRUE ~ "indefini - categorie autre"))

  # 3e § lgt etudiants - /!\ pas les DOM, ou FRPROV n'est pas dans le jeu d'indicteur
  nb_ls_etu <- amorce %>%
    dplyr::mutate(a_garder = dplyr::case_when(
      .data$TypeZone == "R" ~ TRUE,
      id_reg == "11" & .data$CodeZone == "FRMETRO" ~ TRUE,
      id_reg != "11" & .data$CodeZone == "FRPROV" ~ TRUE,
      TRUE ~ FALSE
    )) %>%
    dplyr::filter(.data$a_garder) %>%
    dplyr::mutate(france_concernee = if_else(id_reg == "11", "France m\u00e9tropolitaine", "France de province")) %>%
    tidyr::pivot_wider(id_cols = "france_concernee", names_from = "TypeZone", values_from = c("nb_ls_etu" ,"part_ls_etu")) %>%
    dplyr::mutate(dplyr::across(dplyr::starts_with("nb_"), ~format_fr_nb(.x, dec = 0)),
                  dplyr::across(dplyr::starts_with("part"), format_fr_pct))

  # commentaire 5e §
  nb_pieces <- ligne_reg %>%
   dplyr::mutate(hausse_indiv_recent = (.data$part_ls_ind_recent > .data$part_ls_ind),
                 baisse_5p_recent = (.data$part_5_pieces_et_plus - .data$part_5_pieces_et_plus_recent ) >= 0) %>%
    dplyr::select(dplyr::contains("hausse"), dplyr::contains("baisse"))

  # mise en forme des valeurs
  ligne_reg <- ligne_reg %>%
    dplyr::mutate(dplyr::across(dplyr::starts_with("nb_"), ~format_fr_nb(.x, dec = 0)),
                  dplyr::across(dplyr::starts_with("part"), format_fr_pct))

  # on récupère les formulations idiomatiques grâce à {propre.datareg}
  verb_reg <- propre.datareg::datareg(code_reg = id_reg)

  # on cree ensuite une liste nommee des differents parametres
  verb2 <- list(#titre
                dif_reg_fr_indiv_titre = indiv_coll$dif_reg_fr_indiv_titre,
                # 1er §
                nom_reg = verb_reg$en_nom_region,
                max_part_bail = format_fr_pct(type_bail$part_type_bail),
                type_bail_maj = type_bail$type_bail_maj,
                # 2e §
                nb_ls_actif = ligne_reg$nb_ls_actif,
                millesime = ligne_reg$millesime,
                nb_ls_loue = ligne_reg$nb_ls_loue,
                nb_ls_vacant = ligne_reg$nb_ls_vacant,
                nb_ls_hors_marche = ligne_reg$nb_ls_hors_marche,
                part_ls_hors_marche = ligne_reg$part_ls_hors_marche,
                nom_reg_2 = verb_reg$de_la_region,
                # 3e §
                france_concernee = nb_ls_etu$france_concernee,
                nb_ls_etu_R = nb_ls_etu$nb_ls_etu_R,
                part_ls_etu_R = nb_ls_etu$part_ls_etu_R,
                part_ls_etu_F = nb_ls_etu$part_ls_etu_F,
                # 4e §
                part_ls_coll_reg = indiv_coll$part_ls_coll_R %>% format_fr_pct(),
                part_ls_ind_reg = indiv_coll$part_ls_ind_R %>% format_fr_pct(),
                dif_reg_fr_indiv_com = indiv_coll$dif_reg_fr_indiv_com,
                com_part_ind_fr = indiv_coll$com_part_ind_fr,
                # 5e §
                annee_mes_recent = annee - 5,
                part_1_2p_reg_recent = ligne_reg$part_1_2_pieces_recent,
                part_1_2p_reg = ligne_reg$part_1_2_pieces,
                hausse_indiv_recent = nb_pieces$hausse_indiv_recent,
                baisse_5p_recent = nb_pieces$baisse_5p_recent,
                part_ls_ind_recent = ligne_reg$part_ls_ind_recent,
                part_5_pieces_et_plus_recent = ligne_reg$part_5_pieces_et_plus_recent,
                part_5_pieces_et_plus = ligne_reg$part_5_pieces_et_plus
                )

  # production du verbatim a partir des elements precedents
  verbatim_chap_2 <- list()

  verbatim_chap_2$intertitre <- glue::glue("Une part de logements individuels {verb2$dif_reg_fr_indiv_titre} niveau national")

  #1er paragraphe bailleur
  paragr1 <- glue::glue("{verb2$max_part_bail} du parc locatif social {verb2$nom_reg} appartient aux {verb2$type_bail_maj}. ")

  #§ marché location
  paragr2 <- glue::glue("Sur les {verb2$nb_ls_actif} logements actifs au 1er janvier {verb2$millesime} de la r\u00e9gion,
                         {verb2$nb_ls_loue} sont lou\u00e9s avec un contrat de location et {verb2$nb_ls_vacant}
                         sont vacants. {verb2$nb_ls_hors_marche} logements se trouvent hors du march\u00e9 de la location, ce qui
                         repr\u00e9sente {verb2$part_ls_hors_marche} du parc total {verb2$nom_reg_2}. \n\n")
  #§ logement étudiant
   if (!(id_reg %in% paste0("0", 1:6))) { #pour éviter que la phrase apparaisse pour les DROM
    paragr3 <- glue::glue("Les {verb2$nb_ls_etu_R} logements \u00e9tudiants repr\u00e9sentent {verb2$part_ls_etu_R} du parc social ",
                          "{verb2$nom_reg} contre {verb2$part_ls_etu_F} en {verb2$france_concernee}. \n\n")
  } else {
    paragr3 <- ""
  }

  #§ logement ind/coll
  paragr4 <- glue::glue("Dans la r\u00e9gion, les logements collectifs constituent la majorit\u00e9 du parc social
                         ({verb2$part_ls_coll_reg}). La part des logements individuels ({verb2$part_ls_ind_reg}) est
                         {verb2$dif_reg_fr_indiv_com} niveau national{verb2$com_part_ind_fr}. \n\n")

  #§ parc recent
  paragr5 <- glue::glue("Dans le parc r\u00e9cent, c\u2019est-\u00e0-dire mis en service depuis le 1er janvier {verb2$annee_mes_recent}, ")

  if(verb2$hausse_indiv_recent){
    paragr5 <- glue::glue(paragr5, "les logements individuels sont proportionnellement plus nombreux
                          ({verb2$part_ls_ind_recent}) que dans l\u0027ensemble du parc social ({verb2$part_ls_ind_reg}). L")
  } else {
    paragr5 <- glue::glue(paragr5, "l")
  }

  paragr5 <- glue::glue(paragr5, "es 1 ou 2 pi\u00e8ces repr\u00e9sentent {verb2$part_1_2p_reg_recent} des logements contre
                         {verb2$part_1_2p_reg} dans le parc total. ")

  if(verb2$baisse_5p_recent) {
    paragr5 <- glue::glue(paragr5, "Seulement {verb2$part_5_pieces_et_plus_recent} des logements du parc r\u00e9cent ont 5 pi\u00e8ces ou plus ({verb2$part_5_pieces_et_plus} dans le parc total). ")
  }

  verbatim_chap_2$commentaires <- glue::glue("{paragr1}\n\n{paragr2}\n\n{paragr3}\n\n{paragr4}\n\n{paragr5}")

  verbatim_chap_2
}

#' Selection des epci mis en avant dans la publication
#'
#' @description Selection des EPCI pour lesquels on aura un détail dans les tableaux et graphiques de la publication.
#'
#' @param nom_reg  Le nom de la region au format texte.
#' @param choix_epci Le parametre utilisateur de détail par epci au format texte : "1- Tous les EPCI de la zone" ou "2- Liste d EPCI à saisir".
#' @param epci_list Le cas echeant, le vecteur des codes epci de reference, définis dans les parametres.
#'
#' @return Un vecteur de codes EPCI.
#' @importFrom dplyr pull intersect filter
#' @importFrom tidyr unnest
#' @importFrom attempt message_if_not
#' @export
#'
#' @examples
#' select_epci(nom_reg = "Bretagne", choix_epci = "1- Tous les EPCI de la zone", epci_list = NULL)
#' select_epci(
#'   nom_reg = "Pays de la Loire", choix_epci = "2- Liste d EPCI à saisir",
#'   epci_list = c("244400404", "244400644")
#' )
select_epci <- function(nom_reg = "Bretagne", choix_epci = "1- Tous les EPCI de la zone",
                        epci_list = NULL) {
  reg <- get_id_reg(nom_reg)

  epci_choisis <- COGiter::liste_zone %>%
    tidyr::unnest("REG") %>%
    dplyr::filter(.data$TypeZone == "Epci", .data$REG == reg) %>%
    dplyr::pull("CodeZone") %>%
    as.character()

  if (grepl("2-", choix_epci)) {
    epci_choisis <- dplyr::intersect(epci_list, epci_choisis)
    attempt::message_if_not(
      .x = length(epci_choisis) == length(epci_list), .p = isTRUE,
      msg = paste0("les EPCI saisis ne sont tous pas dans la region ", nom_reg)
    )
  }

    if (grepl("3-", choix_epci)) {
      epci_choisis <- NULL
  }
  epci_choisis
}

# to do mieux traiter les facteurs

#' Creation du 2e graphique du chapitre Loyers et financements, representant le loyer moyen pour le parc total et le parc recent de la region selon le mode de financement
#'
#' @description Mise en page du diagramme en bâtons représentant le loyer moyen selon le mode de financement, pour le parc total et le parc récent.
#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref.
#' @param annee Le millésime renseigné par l'utilisateur, au format numérique.
#' @param palette choix de la palette de couleur parmi celle de \code{gouvdown::\link{scale_color_gouv_discrete}}
#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Loyer moyen des logements sociaux selon le type de financement au 01/01/{annee}")
#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
#'
#' @return Une liste de 3 objets : Un ggplot intéractif au format html (viz),
#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
#'
#' @importFrom dplyr filter select starts_with contains mutate
#' @importFrom forcats fct_relevel
#' @importFrom ggiraph geom_bar_interactive ggiraph
#' @importFrom ggplot2 ggplot aes position_dodge scale_x_discrete scale_y_continuous theme element_blank labs
#' @importFrom glue glue
#' @importFrom gouvdown scale_fill_gouv_discrete
#' @importFrom rlang .data
#' @importFrom tidyr pivot_longer pivot_wider
#' @export
#'
#' @examples
#' indicateurs_rpls_illustrations <- lire_rpls_exemple() %>%
#'  dplyr::filter(Zone_ref)
#'
#' creer_graphe_6_2(data = indicateurs_rpls_illustrations, annee = 2020, note_de_lecture = "")[["viz"]]

creer_graphe_6_2 <- function(data, annee, palette = "pal_gouv_qual2",
                             titre = NULL,
                             note_de_lecture = "") {

  if (is.null(titre)){
    titre <- "Loyer moyen des logements sociaux \nselon le type de financement au 01/01/{annee}"
    }

  # une variable pour recuperer l'identifiant de la région choisie
  id_reg <- dplyr::filter(data, .data$Zone_ref, grepl("gion", .data$TypeZone)) %>%
    dplyr::pull("CodeZone") %>% unique() %>% as.character

  # un booleen pour determiner si la region choisie est metropolitaine ou non
  metro <- !(id_reg %in% paste0("0", 1:6))
  # Un vecteur de noms des financements qui s'adapte au contexte metropolitain ou DROM
  if(metro) {
    etiquette_financements <- c("PLUS", "PLAI", "PLS", "PLI", "Total")
  } else {
    etiquette_financements <- c("LLS", "LLTS", "PLS", "PLI", "Total")
  }

  creer_graphe_6_2 <- data %>%
    # filtre sur la région et pour le millesime souhaite
    dplyr::filter(.data$TypeZone == "R\u00e9gions" & .data$millesime == annee) %>%
    # selection des variables necessaires au graphe
    dplyr::select("Zone", dplyr::starts_with("somme"), -dplyr::contains(c("_mes", "_age_", "_enqpv")),
                  -"somme_loyer", -"somme_surface", -"somme_loyer_recent", -"somme_surface_recent") %>%
    # passage au format long de la table en distinguant le financement du type de logement (recent ou pas)
    tidyr::pivot_longer(
      cols = -"Zone", names_to = c("variable", "financement", "type"), values_to = "values",
      names_pattern = "(loyer|surface)[_]nb_(plus|plai|pls|pli)[_]{0,1}(.*)"
    ) %>%
    tidyr::pivot_wider(names_from = "variable", values_from = "values") %>%
    # creation de la modalite parc total
    dplyr::mutate(type = ifelse(.data$type == "", "total", .data$type),
                  facette = "Par type de financement")


  creer_graphe_6_2 <- dplyr::bind_rows(creer_graphe_6_2,
                                     #calcul des loyers et surfaces totaux "Tous types de financements"
                                     creer_graphe_6_2 %>%
                                       dplyr::group_by(.data$Zone, .data$type) %>%
                                       dplyr::summarise(loyer = sum(.data$loyer,na.rm = TRUE), surface = sum(.data$surface, na.rm = TRUE), .groups = "drop") %>%
                                       dplyr::mutate(facette = "Tous types de financements",
                                                     financement = "Total")) %>%
    dplyr::mutate(loyer_moyen = .data$loyer/.data$surface,
                  financement = forcats::fct_relevel(.data$financement,"plus","plai","pls","pli","Total"),
                  facette = as.factor(.data$facette))

  g_bar <- ggplot2::ggplot(data = creer_graphe_6_2,
                           ggplot2::aes(x = .data$financement, y = .data$loyer_moyen,
                                        fill = forcats::fct_relevel(.data$type, "total", "recent"),
                                        # information a faire apparaitre dans les bulles: le nb_ls avec separateur des milliers
                                        tooltip = format_fr_nb(.data$loyer_moyen)
                           )) +
    # geom_bar en version interactif
    ggiraph::geom_bar_interactive(stat = "identity", position = ggplot2::position_dodge()) +
    # gestion des libelles de l axe des abscisses
    ggplot2::scale_x_discrete(
      breaks = c("plus", "plai", "pls", "pli", "Total"),
      labels = etiquette_financements
    ) +
    # gestion des libelles de la legende
    gouvdown::scale_fill_gouv_discrete(palette = palette, breaks = c("total", "recent"),
                                       labels = c("Parc total", "Parc r\u00e9cent (5 ans ou moins)")) +
    # formatage de l axe des ordonnees
    ggplot2::scale_y_continuous(labels = function(x) format_fr_nb(x, dec = 0),
                                breaks = seq(0, max(dplyr::pull(creer_graphe_6_2, .data$loyer_moyen), na.rm = TRUE) + 1, 2)) +
    ggplot2::theme(
      #suppression des labellers du facette
      strip.background = ggplot2::element_blank(),
      strip.text.x = ggplot2::element_blank(),
      legend.title = ggplot2::element_blank(),
      legend.position = "bottom"
    ) +
    # habillage simple
    ggplot2::labs(
      title = glue::glue(titre),
      subtitle = "Unit\u00e9 : \u20ac/m\u00b2 de surface habitable",
      x = "",
      y = "",
      caption = dplyr::if_else(note_de_lecture != "" ,
                               paste0(note_de_lecture, "\n\n", caption(sources = 1, mil_rpls = annee)),
                               caption(sources = 1, mil_rpls = annee))) +
    ggplot2::facet_grid(~.data$facette,scales="free", space="free_x")
  # transformation par ggiraph
  graphe <- ggiraph::ggiraph(code = print(g_bar))

  # donnees a faire figurer dans l'export xls
  data_xls <- dplyr::select(creer_graphe_6_2 , -c("loyer", "surface", "facette"))

  # metadonnees a faire figurer dans la table des matiere de l'export xls
  index <- data.frame(onglet = "graphe_6_2", titre = glue::glue(titre) %>% gsub("\n", " ", .))

  return(list(viz = graphe, tab_xls = data_xls, meta = index))


  }

#' Mentions legales : Verbatim
#'
#' @description Production des commentaires verbatim des mentions légales.
#'
#' @param date_publication La date de publication. Par défaut la date du jour, pour personnaliser, utiliser le format JJ/MM/AAAA.
#' @param nom_reg Le nom de la region au format texte, tel qu'issu de la saisie utilisateur, par exemple '01 Guadeloupe'.
#'
#' @return Un vecteur de 11 chaînes de caractères comprenant la date de publication, les informations relatives au service gestionnaire,
#' à la direction de publication, au développement, à l'issn, à l'hébergement, aux droits d'auteur, aux codes sources, à la création de liens,
#' aux usages et au traitements des données personnelles.
#'
#' @importFrom glue glue
#' @importFrom lubridate today ymd
#' @importFrom propre.datareg datareg
#' @importFrom rlang .data
#' @importFrom stringr str_sub
#'
#' @export
#'
#' @examples
#' creer_verbatim_mentions_legales(nom_reg = "Bretagne")

creer_verbatim_mentions_legales <- function(date_publication = lubridate::today(), nom_reg = "Bretagne") {

  # Formatage de la date
  if(date_publication == lubridate::today()){
    date_publication <- format(lubridate::ymd(date_publication), format = "%d %B %Y")
  } else {
    # On part du principe que l utilisateur remplira une date sous format jj/mm/aaaa
    date_publication <- format(lubridate::ymd(paste0(stringr::str_sub(date_publication, 7, 10),
                                                     stringr::str_sub(date_publication, 4, 5),
                                                     stringr::str_sub(date_publication, 1, 2))), format = "%d %B %Y")
  }

  # Récupération du code région et des donnees regionales de mentions legales
  id_reg <- get_id_reg(nom_reg)
  mentions_reg <- propre.datareg::datareg(code_reg = id_reg)

  # Création de la liste avec les parties des mentions légales contenant des éléments à paramétrer
  verbatim_mentions_legales <- list(date = "", service_gestionnaire = "", direction_publication = "", developpement ="",
                                    issn = "", hebergement = "", droit_auteur = "", code_source = "", lien = "",
                                    usage = "", donnees_perso = "")

  # Paramétrage de la date de publication
  verbatim_mentions_legales$date <- glue::glue("Publi\u00e9 le {date_publication}")

  # Paramétrage des infos relatives au service gestionnaire
  verbatim_mentions_legales$service_gestionnaire <- glue::glue("{mentions_reg$nom_dreal}\n
  {mentions_reg$adresse}\n
  T\u00e9l\u00e9phone : {mentions_reg$telephone}\n
  Courriel : {mentions_reg$courriel_contact}")

  # Paramétrage des infos relatives à la direction de publication
  verbatim_mentions_legales$direction_publication <- glue::glue("{mentions_reg$prenom_directeur_directrice} {mentions_reg$nom_directeur_directrice}, {mentions_reg$titre}.")

  # Paramétrage des infos relatives au développement
  verbatim_mentions_legales$developpement <- "- Cl\u00e9ment Belliard\n- Fabio Dos Santos Pereira\n- Juliette Engelaere-Lefebvre\n- Franck Gaspard\n- Daniel Kalioudjoglou\n- Murielle Lethrosne\n- Jean-Bernard Salomond\n- Mael Theuli\u00e8re\n- Arnaud Wilczynski\n- Marouane Zellou"

  # Paramétrage des infos relatives à l'ISSN
  verbatim_mentions_legales$issn <- "En cours"

  # Paramétrage des infos relatives à l'hébergement
  verbatim_mentions_legales$hebergement <- "http://dreal.statistiques.developpement-durable.gouv.fr/"

  # Paramétrage du texte sur le droit d'auteur
  verbatim_mentions_legales$droit_auteur <- glue::glue("Tous les contenus pr\u00e9sents sur ce site sont couverts par le droit d\'auteur.
  Toute reprise est d\u00e8s lors conditionn\u00e9e \u00e0 l\'accord de l\'auteur en vertu de l\'article
  L.122-4 du Code de la Propri\u00e9t\u00e9 Intellectuelle.\n
  Toutes les informations li\u00e9es \u00e0 cette publication (donn\u00e9es et textes) sont publi\u00e9es sous licence ouverte/open licence v2
  (dite licence Etalab) : quiconque est libre de r\u00e9utiliser ces informations sous r\u00e9serve, notamment, d\'en mentionner la filiation.\n
  Tous les scripts sources du package sont disponibles sous licence [GPL-3.0-or-later](https://spdx.org/licenses/GPL-3.0-or-later.html). \n
  La [charte graphique de la marque d'\u00c9tat](https://www.gouvernement.fr/charte/charte-graphique-les-fondamentaux/la-typographie)
  est \u00e0 usage exclusif des acteurs de la sphe\u0300re e\u0301tatique.
  En particulier, la typographie Marianne\u00a9 est prot\u00e9g\u00e9e par le droit d'auteur.")

  # Paramétrage des infos relatives aux codes sources
  verbatim_mentions_legales$code_source <- "L\u2019ensemble des scripts de collecte et de datavisualisation est disponible
  sur le r\u00e9pertoire gitlab du r\u00e9seau des statisticiens en DREAL (https://gitlab.com/rdes_dreal/propre.rpls).
  Vous pouvez y reporter les \u00e9ventuels bugs ou demandes d'\u00e9volution au niveau de la rubrique _Issues_."

  # Paramétrage des infos relatives aux liens
  verbatim_mentions_legales$lien <- "Tout site public ou priv\u00e9 est autoris\u00e9 \u00e0 \u00e9tablir, sans autorisation pr\u00e9alable,
  un lien vers les informations diffus\u00e9es par le Minist\u00e8re de la Transition \u00c9cologique et de la Coh\u00e9sion des Territoires.\n
  L\u2019autorisation de mise en place d\'un lien est valable pour tout support, \u00e0 l\'exception de ceux diffusant des informations
  \u00e0 caract\u00e8re pol\u00e9mique, pornographique, x\u00e9nophobe ou pouvant, dans une plus large mesure porter atteinte
  \u00e0 la sensibilit\u00e9 du plus grand nombre.\n
  Pour ce faire, et toujours dans le respect des droits de leurs auteurs, une ic\u00f4ne Marianne est disponible
  sur le site https://www.gouvernement.fr/marque-Etat pour agr\u00e9menter votre lien et pr\u00e9ciser que le site d\'origine
  est celui du Minist\u00e8re de la Transition \u00c9cologique et de la Coh\u00e9sion des Territoires."

  # Paramétrage du texte sur les usages
  verbatim_mentions_legales$usage <- glue::glue("Les utilisateurs sont responsables des interrogations qu\'ils formulent ainsi que de
  l\'interpr\u00e9tation et de l\'utilisation qu\'ils font des r\u00e9sultats.
  Il leur appartient d\'en faire un usage conforme aux r\u00e9glementations en vigueur et aux recommandations de la CNIL
  lorsque des donn\u00e9es ont un caract\u00e8re nominatif (loi n\u00b0 78.17 du 6 janvier 1978, relative \u00e0 l\'informatique,
  aux fichiers et aux libert\u00e9s dite loi informatique et libert\u00e9s).\n
  Il appartient \u00e0 l\'utilisateur de ce site de prendre toutes les mesures appropri\u00e9es de fa\u00e7on \u00e0 prot\u00e9ger
  ses propres donn\u00e9es et/ou logiciels de la contamination par d\'\u00e9ventuels virus circulant sur le r\u00e9seau Internet.
  De mani\u00e8re g\u00e9n\u00e9rale, la {mentions_reg$nom_dreal} d\u00e9cline toute responsabilit\u00e9 quant \u00e0 un \u00e9ventuel
  dommage survenu pendant la consultation du pr\u00e9sent site.
  Les messages que vous pouvez nous adresser transitant par un r\u00e9seau ouvert de t\u00e9l\u00e9communications,
  nous ne pouvons assurer leur confidentialit\u00e9.")

  # Paramétrage des infos relatives au traitement des données personnelles
  verbatim_mentions_legales$donnees_perso <- "L\u2019outil ne fait pas d\'usage interne de donn\u00e9es \u00e0 caract\u00e8re personnel."

  # Affichage du résultat
  verbatim_mentions_legales

}

#' fonction utilitaire de formatage en pourcentage pour le francais
#'
#' @description fonction utilitaire de formatage en pourcentage pour le francais

#' @param x un nombre à formater en pourcentage
#' @param dec un entier désignant le nombre de chiffres après la virgule souhaité (1 par défaut)
#'
#' @return une chaîne de texte, x %, avec transformation de la décimale en virgule et insertion d'un espace insécable
#'
#' @importFrom attempt stop_if_not
#'
#' @export
#'
#' @examples
#' format_fr_pct(100/3)
#'

#' @importFrom attempt stop_if_not
format_fr_pct <- function(x, dec = 1) {
  attempt::stop_if_not(x, is.numeric, msg = "x n'est pas un nombre, revoyez la saisie de l'argument de format_fr_pct(x, dec)")
  paste0(formatC(x, decimal.mark = ",", big.mark = "\u202f", format = "f", digits = dec), "\u00a0%")
}

#' fonction utilitaire de formatage de nombre pour le francais
#'
#' @description fonction utilitaire de formatage de nombre pour le francais

#' @param x un nombre à formater en français
#' @param dec un entier désignant le nombre de chiffres après la virgule souhaité (1 par défaut)
#' @param big_mark le séparateur des milliers
#' @return une chaîne de texte avec transformation de la décimale en virgule et insertion d'un caractère spécifié via big_mark au niveau du séparateur de milliers
#'
#' @importFrom attempt stop_if_not
#'
#' @export
#'
#' @examples
#' format_fr_nb(10000000/7)

#' @importFrom attempt stop_if_not
format_fr_nb <- function(x, dec = 1, big_mark) {
  attempt::stop_if_not(x, is.numeric, msg = "x n'est pas un nombre, revoyez la saisie de l'argument de format_fr_nb(x, dec)")

  if(missing("big_mark")) {big_mark <- "\u202f"}
  paste0(formatC(x, decimal.mark = ",", format = "f", digits = dec, big.mark = big_mark))
}

#' normalisation d'une chaine de texte
#'
#' str_standardize enleve les accents, les espaces et les caracteres speciaux d'une chaine de texte.
#' Cette fonction provient du package {tricky} de Paul-Antoine Chevalier (https://github.com/pachevalier/tricky), merci à lui !
#'
#' Voir http://stackoverflow.com/a/36898175/1967500 pour enlever les accents
#'
#' @param string une chaine de texte a normaliser
#' @param prefix la chaine de texte a ajouter en prefixe au besoin (seulement devant des chiffres, c'est utile en cas de renommage de variables)
#' @source https://github.com/pachevalier/tricky/blob/master/R/strings.R
#'
#' @return  une chaine de texte normalisee
#' @export
#'
#' @examples
#' str_standardize("2017/07/07", prefix = "date_")
#' str_standardize("code externe de l'action")
#'
#' @importFrom stringi stri_trans_general
#' @importFrom stringr str_trim str_to_lower str_replace_all str_replace
#'
str_standardize <- function(string, prefix = "") {
  string %>%
    stringr::str_trim(side = "both") %>%
    stringr::str_to_lower() %>%
    stringi::stri_trans_general(
      id = "Latin-ASCII"
    ) %>%
    stringr::str_replace_all(
      pattern = "[[:blank:][:punct:]\n]+",
      replacement = "_"
    ) %>%
    stringr::str_replace_all(
      pattern = "[\\[\\]\\(\\)]",
      replacement = ""
    ) %>%
    stringr::str_replace(
      pattern = "^([[:digit:]].*)",
      replacement = paste0(prefix, "\\1")
    )
}

#' Incrementation de l'export xls
#'
#' incrementer_export_xls sert a incrementer la table des matiere et a ajouter un onglet dans le tableur d'export xls des donnees visualisees.
#'
#' @param visuel_cree la liste de 3 objets (viz, meta, et tab_xls) resultat de la fonction d'illustration propre.rpls
#' @param list_xls nom de l'objet de type liste qui rassemble les informations des differentes illustrations a exporter vers excel, a creer en debut de book
#' @param ongl_index nom de l'onglet de la table des matieres (1er composant de la liste `list_xls`)
#'
#'
#' @return  l'objet de type liste qui rassemble les informations a exporter vers excel, enrichi des informations relatives au visuel `visuel_cree`
#' (nouvel onglet et nouvelle ligne dans la table des matieres)
#' @export
#' @importFrom attempt stop_if_not
#' @importFrom dplyr bind_rows
#'
#' @examples
#' tab_1_1 <- creer_tableau_1_1(data = lire_rpls_exemple() %>% dplyr::filter(Zone_ref), annee = 2022)
#' incrementer_export_xls(tab_1_1)


incrementer_export_xls <- function(visuel_cree, list_xls = list(), ongl_index = "index"){

  # Verification de la validité des arguments
  attempt::stop_if_not(.x = list_xls, .p = is.list,
                       msg = "l'argument list_xls renseigne n'est pas de type list ou n'existe pas, revoyez votre saisie")
  attempt::stop_if_not(.x = visuel_cree, .p = ~ is.list(.x) & length(.x) == 3,
                       msg = "l'argument visuel_cree renseigne ne correspond pas au resultat d'une fonction de creation d'illustration de propre.rpls, revoyez votre saisie")

  # Recuperartion du contenu initial de la liste list_xls
  export_enrichi <- list_xls

  # Incrementation de la table des matiere
  #  - pour le 1er visuel, la table des matiere n'est pas amorcee
  if(is.null(list_xls[[ongl_index]])) {
    export_enrichi[[ongl_index]] <- data.frame(onglet = character(), titre = character())
  }
  # - on ajoute la ligne dans la table des matiere pre-existante si la creation de viz renvoie qqch
  if(!is.null(visuel_cree[["meta"]])) {
    export_enrichi[[ongl_index]] <- dplyr::bind_rows(export_enrichi[[ongl_index]], visuel_cree[["meta"]])
  }

  # on stocke les donnees du visuel dans un nouvel onglet de l'export xls
  if(!is.null(visuel_cree[["tab_xls"]])) {
    export_enrichi[[visuel_cree[["meta"]]$onglet]] <- visuel_cree[["tab_xls"]]
  }
  return(export_enrichi)
}


#' Visualisation d'une illustration.
#'
#' Visualisation d'une illustration html creee par une fonction de propre.rpls.
#'
#' @param visuel_cree la liste de 3 objets (viz, meta, et tab_xls) resultat de la fonction d'illustration propre.rpls
#'
#' @return une illustration au format html
#' @export
#'
#' @examples
#' tab_1_1 <- creer_tableau_1_1(data = lire_rpls_exemple() %>% dplyr::filter(Zone_ref), annee = 2022)
#' afficher_visuel(tab_1_1)
afficher_visuel <- function(visuel_cree) {
  visuel_cree$viz
}

#' Creation du 2e graphique du chapitre sur les mises en service et les sorties, representant les mises en services en et hors quartiers prioritaires de la politique de la ville.
#' @description Création du graphique en barres réprésentant le nombre de logements entrés dans le patrimoine des bailleurs selon
#' qu'ils sont situés ou non en zone QPV (quartier prioritaire de la ville)
#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref.
#' @param annee Une année parmi les millésimes sélectionnables par l'utilisateur, au format numérique.
#' @param palette choix de la palette de couleur parmi celle de \code{gouvdown::\link{scale_color_gouv_discrete}}
#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Logements mis en service en {annee-1} dans et hors quartiers prioritaires de la politique de la ville (QPV)")
#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
#'
#' @return Une liste de 3 objets : un graphique en barres interactif au format html (viz),
#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
#'
#' @importFrom dplyr filter select mutate case_when pull
#' @importFrom forcats fct_relevel fct_drop
#' @importFrom ggiraph geom_bar_interactive ggiraph
#' @importFrom ggplot2 ggplot aes labs
#' @importFrom gouvdown scale_fill_gouv_discrete
#' @importFrom stringr str_detect
#' @importFrom tidyr pivot_longer
#' @importFrom rlang .data
#' @importFrom glue glue
#'
#' @export
#'
#' @examples
#' indicateurs_rpls_illustrations <- lire_rpls_exemple() %>%
#'  dplyr::filter(Zone_ref)
#'
#' creer_graphe_3_2(data = indicateurs_rpls_illustrations, annee = 2019, note_de_lecture = "")[["viz"]]


creer_graphe_3_2 <- function(data, annee, palette = "pal_gouv_div1",
                             titre = NULL,
                             note_de_lecture = ""){

  if (is.null(titre)){
    titre <- "Logements mis en service en {annee-1} dans et hors quartiers prioritaires de la politique de la ville (QPV)"}
  # Création de la table utile à la production du graphique
  tab <- data %>%
    # Filtres pour ne garder que les données de la région et du millésime sélectionné
    dplyr::filter(.data$TypeZone == "R\u00e9gions",
                  .data$millesime == annee) %>%
    # Sélection des variables utiles pour le graphique
    dplyr::select("TypeZone", "Zone", "millesime",
                  "nb_mes_qpv_construit_org", "nb_mes_qpv_acq_av_travaux",
                  "nb_mes_qpv_acq_ss_travaux", "nb_mes_qpv_acq_vefa",
                  "nb_mes_nonqpv_construit_org", "nb_mes_nonqpv_acq_av_travaux",
                  "nb_mes_nonqpv_acq_ss_travaux", "nb_mes_nonqpv_acq_vefa") %>%
    # Passage du format large au format long
    tidyr::pivot_longer(-c("TypeZone", "Zone", "millesime"),
                        values_to = "Nb_logements", names_to = c("Variable"),
                        names_pattern = "nb_mes_?(.*)") %>%
    # Création des deux variables relatives à QPV / hors QPV et à l'entrée dans le patrimoine
    dplyr::mutate(Zone_QPV = ifelse(stringr::str_detect(string = .data$Variable, pattern = "^qpv"), "En QPV", "Hors QPV"),
                  Entree_patrimoine = dplyr::case_when(
                    stringr::str_detect(string = .data$Variable, pattern = "construit_org") ~ "Construit par\nl\'organisme",
                    stringr::str_detect(string = .data$Variable, pattern = "acq_av_travaux") ~ "Acquis avec\ntravaux",
                    stringr::str_detect(string = .data$Variable, pattern = "acq_ss_travaux") ~ "Acquis sans\ntravaux",
                    stringr::str_detect(string = .data$Variable, pattern = "acq_vefa") ~ "Acquis en\nVEFA"),
                  Entree_patrimoine = as.factor(.data$Entree_patrimoine),
                  Entree_patrimoine = forcats::fct_relevel(.data$Entree_patrimoine,
                                                           "Construit par\nl\'organisme", "Acquis en\nVEFA",
                                                           "Acquis avec\ntravaux", "Acquis sans\ntravaux"),
                  # Suppression des modalités de "millesime" non retenues
                  millesime = forcats::fct_drop(millesime))


  # Création du graphique
  graphe <- ggplot2::ggplot(data = tab, mapping = ggplot2::aes(x = .data$Entree_patrimoine, y = .data$Nb_logements,
                                                               fill = .data$Zone_QPV)) +
    # Création graphique en barres en mode interactif
    ggiraph::geom_bar_interactive(stat = "identity", data_id = row.names(tab),
                                  tooltip = format(dplyr::pull(tab, "Nb_logements"), big.mark = " ")) +
    # Paramétrage titre, sous-titre, axes ...
    ggplot2::labs(title = stringr::str_wrap(glue::glue(titre),
                                            width = 55),
                  subtitle = "Unit\u00e9 : nombre de logements",
                  x = "",
                  y = "",
                  fill = "",
                  caption = dplyr::if_else(note_de_lecture != "" ,
                                           paste0(note_de_lecture, "\n\n", caption(sources = 1, mil_rpls = annee)),
                                           caption(sources = 1, mil_rpls = annee))) +
    ggplot2::scale_y_continuous(labels = function(x) format(x, big.mark = " "))  +
    scale_fill_gouv_discrete(palette = palette)

  # Ajout de l'interactivité
  graphe <- ggiraph::ggiraph(code = print(graphe))

  # donnees a faire figurer dans l'export xls
  data_xls <- dplyr::select(tab , -"TypeZone", -"Variable") %>%
    dplyr::mutate(Entree_patrimoine = gsub("\n", "", .data$Entree_patrimoine))

  # metadonnees a faire figurer dans la table des matieres de l'export xls
  index <- data.frame(onglet = "graphe_3_2", titre = glue::glue(titre))

  return(list(viz = graphe, tab_xls = data_xls, meta = index))

}

#' Creation de la 2e carte du chapitre sur la tension du parc, representant le taux de mobilite par EPCI.
#'
#' @description Création de la carte représentant le taux de mobilité par EPCI pour l'année N choisie.
#'
#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur.
#' @param annee Une année parmi les millésimes sélectionnables par l'utilisateur, au format numérique.
#' @param carto La table des fonds de carte realisee avec \code{mapfactory::\link{fond_carto}}.
#' @param bornes Les bornes manuelles.
#' @param palette choix de la palette de couleurs parmi celle de \code{gouvdown::\link{scale_color_gouv_discrete}}
#' @param inverse choix du sens de la progression des couleurs : du plus foncé au plus clair (FALSE) ou du plus clair au plus foncé (TRUE)
#' @param maille le maillage souhaite pour la carte, a choisir parmi "commune", "EPCI" ou "département". "EPCI" par defaut.
#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Taux de mobilité par {maille} en {annee-1}")
#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
#' @param na_label L'etiquette à afficher dans la legende pour les valeurs manquantes ("Valeurs manquantes" par défaut).
#' @param ... autres paramètres de la fonction[\code{mapfactory::creer_carte}](https://dreal-pdl.gitlab-pages.din.developpement-durable.gouv.fr/csd/mapfactory/reference/creer_carte.html).
#'
#' @return Une liste de 3 objets : une carte choroplethe mise en page au format html (viz),
#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
#'
#' @importFrom dplyr filter slice pull if_else select
#' @importFrom glue glue
#' @importFrom mapfactory creer_carte
#' @importFrom COGiter list_epci_in_reg list_com_in_reg
#' @export
#'
#' @examples
#' indicateurs_rpls <- lire_rpls_exemple()
#'
#' creer_carte_5_2(data = indicateurs_rpls,
#'                 annee = 2019,
#'                 carto = mapfactory::fond_carto("Corse"),
#'                 bornes = NULL,
#'                 note_de_lecture = "")[["viz"]]


creer_carte_5_2 <- function(data, annee, carto, bornes = NULL, palette = "pal_gouv_o", inverse = TRUE, maille = "EPCI",
                            titre = "Taux de mobilit\u00e9 par {maille} en {annee-1}",
                            note_de_lecture = "", na_label = "Valeurs manquantes", ...) {

  # récupérer le code de la région à partir du jeu de données
  reg <- data %>%
    dplyr::filter(.data$TypeZone == "R\u00e9gions", .data$Zone_ref == TRUE) %>%
    dplyr::slice(1) %>%
    dplyr::pull("CodeZone") %>%
    as.character()

  # preparer la table à visualiser
  data <- data %>%
    dplyr::filter(.data$millesime == annee)

  map <- mapfactory::creer_carte(data = data, code_region = reg, carto = carto, maillage = maille, indicateur = taux_mobilite,
                                 type_viz = "choroplethe", palette = palette, inverse = inverse, interactive = TRUE,
                                 titre = glue::glue(titre), decimales = 1,
                                 bas_de_page = dplyr::if_else(note_de_lecture != "" ,
                                                              paste0(note_de_lecture, "\n\n", caption(sources = 1, mil_rpls = annee)),
                                                              caption(sources = 1, mil_rpls = annee)),
                                 evolution = FALSE, suffixe = " %", na_label = na_label, bornes = bornes, ...)
  # donnees a faire figurer dans l'export xls
  codes_zones_a_garder <- c(COGiter::list_epci_in_reg(reg), COGiter::list_com_in_reg(reg))
  data_xls <- data %>%
    # filtre sur la region et la maille de la carte, attention les noms de mailles dans TypeZone sont légèrement différents du paramètre maille
    dplyr::filter(grepl(tolower(maille), tolower(.data$TypeZone)), .data$CodeZone %in% codes_zones_a_garder) %>%
    dplyr::select("CodeZone", "Zone", "taux_mobilite")

  # metadonnees a faire figurer dans la table des matiere de l'export xls
  index <- data.frame(onglet = "carte_5_2", titre = glue::glue(titre))

  return(list(viz = map, tab_xls = data_xls, meta = index))

}

#' Creation du graphique du chapitre sur les evolutions du parc, representant l evolution en base 100 du nombre de logements sociaux ces 5 dernieres annees pour la region et deux territoires supra de comparaison.
#' @description Création du graphique représentant l'évolution en base 100 du nombre de logements sociaux sur 6 ans
#' (de 5 années avant l'année choisie jusqu'à l'année choisie).
#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref.
#' @param annee Une année parmi les millésimes sélectionnables par l'utilisateur, au format numérique.
#' @param palette choix de la palette de couleur parmi celle de \code{gouvdown::\link{scale_color_gouv_discrete}}
#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Évolution du nombre de logements sociaux")
#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
#'
#' @return Une liste de 3 objets : un graphique en courbes interactif au format html (viz),
#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
#'
#' @importFrom dplyr filter select group_by mutate first ungroup pull
#' @importFrom forcats fct_drop
#' @importFrom ggiraph geom_point_interactive ggiraph
#' @importFrom ggplot2 ggplot aes geom_line labs
#' @importFrom gouvdown scale_color_gouv_discrete
#' @importFrom rlang .data
#'
#' @export
#'
#' @examples
#' indicateurs_rpls_illustrations <- lire_rpls_exemple() %>%
#'  dplyr::filter(Zone_ref)
#'
#' creer_graphe_1_1(data = indicateurs_rpls_illustrations, annee = 2019, note_de_lecture = "")[["viz"]]


creer_graphe_1_1 <- function(data, annee, palette = "pal_gouv_qual2", titre = "\u00c9volution du nombre de logements sociaux", note_de_lecture = ""){

  # Création de la table utile à la production du graphique
  tab <- data %>%
    # Filtres pour ne garder que les données de la région et du millésime sélectionné
    dplyr::filter(.data$TypeZone %in% c("R\u00e9gions", "France"),
                  .data$millesime %in% annee:(annee-5)) %>%
    # Sélection des variables utiles pour le graphique
    dplyr::select("TypeZone", "Zone", "millesime", "nb_ls_actif") %>%
    # Regroupement des valeurs selon les modalités de la variable `Zone` pour calcul des valeurs en base 100
    dplyr::group_by(.data$Zone) %>%
    # On s'assure que le dataset est ordonné correctement selon les années pour calcul des évolutions base 100
    dplyr::arrange(as.character(.data$millesime)) %>%
    # Création d'une variable calculant l'évolution en base 100 (depuis 4 année avant l'annee choisie)
    dplyr::mutate(Evol_ls_B100 = 100*.data$nb_ls_actif / dplyr::first(.data$nb_ls_actif),
                  # Suppression des modalités de "millesime" non retenues
                  millesime = forcats::fct_drop(.data$millesime)) %>%
    # Dégroupement des groupes réalisés
    dplyr::ungroup()


  # Création du graphique
  graphe <- ggplot2::ggplot(data = tab, mapping = ggplot2::aes(x = .data$millesime, y = .data$Evol_ls_B100)) +
    # Traçage des courbes lignes (non animées)
    ggplot2::geom_line(mapping = ggplot2::aes(color = .data$Zone, group = .data$Zone)) +
    # Traçage des points en interactif
    ggiraph::geom_point_interactive(mapping = ggplot2::aes(color = .data$Zone), size = 2, data_id = row.names(tab),
                                    tooltip = paste0("Nombre de logements sociaux : ",
                                                     format(dplyr::pull(tab, "nb_ls_actif"), big.mark = " "))) +
    # Paramétrage titre, sous-titre, axes ...
    ggplot2::labs(title = titre,
                  subtitle = paste0("Base 100 au 01/01/",
                                    min(levels(dplyr::pull(tab, "millesime")))),
                  x = "",
                  y = "",
                  caption = dplyr::if_else(note_de_lecture != "" ,
                                           paste0(note_de_lecture, "\n\n", caption(sources = 1, mil_rpls = annee)),
                                           caption(sources = 1, mil_rpls = annee))) +
    ggplot2::theme(legend.position = "bottom") +
    ggplot2::guides(color = ggplot2::guide_legend(title = "", nrow = 2, byrow = TRUE)) +
    gouvdown::scale_color_gouv_discrete(palette = palette) +
    ggplot2::scale_y_continuous(labels = ~format_fr_nb(x = .x, dec = 0))

  graphe <- ggiraph::ggiraph(code = print(graphe))

  # donnees a faire figurer dans l'export xls
  data_xls <- dplyr::select(tab , -"TypeZone")

 # metadonnees a faire figurer dans la table des matiere de l'export xls
  index <- data.frame(onglet = "graphe_1_1", titre = titre)

  return(list(viz = graphe, tab_xls = data_xls, meta = index))

}

#' Creation de la carte du chapitre sur les evolutions du parc, representant l evolution annuelle du nombre de logements sociaux par EPCI.
#'
#' @description Mise en page de la carte du chapitre 1 au format html, concernant l'évolution annuelle du nombre de logements sociaux.
#'
#' @param data La table préparée par dataprep() selon les inputs de l'utilisateur.
#' @param annee Le millésime renseigné par l'utilisateur.
#' @param carto La table des fonds de carte realisee avec \code{mapfactory::\link{fond_carto}}.
#' @param bornes Les bornes manuelles de la légende, mettre à NULL pour utiliser la méthode par défaut (quantile).
#' @param palette choix de la palette de couleur parmi celle de \code{gouvdown::\link{scale_color_gouv_discrete}}
#' @param inverse choix du sens de la progression des couleurs : du plus foncé au plus clair (FALSE) ou du plus clair au plus foncé (TRUE)
#' @param maille le maillage souhaite pour la carte, a choisir parmi "commune", "EPCI" ou "département". "EPCI" par defaut.
#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Évolution du nombre de logements sociaux par {maille}")
#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
#' @param na_label L'etiquette à afficher dans la legende pour les valeurs manquantes ("Valeurs manquantes" par défaut).
#' @param decimales Le nombre de decimales voulu pour les bornes de la legende (0 par defaut)
#' @param ... autres paramètres de la fonction [\code{mapfactory::creer_carte}](https://dreal-pdl.gitlab-pages.din.developpement-durable.gouv.fr/csd/mapfactory/reference/creer_carte.html).
#'
#' @return Une liste de 3 objets : une carte mise en page au format html (viz),
#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
#'
#' @importFrom dplyr filter slice pull if_else ends_with select
#' @importFrom COGiter list_epci_in_reg list_com_in_reg
#' @importFrom glue glue
#' @importFrom mapfactory creer_carte
#'
#' @export
#'
#' @examples
#' indicateurs_rpls <- lire_rpls_exemple()
#' creer_carte_1_1(
#'   data = indicateurs_rpls,
#'   carto = mapfactory::fond_carto("Corse"),
#'   annee = 2019,
#'   bornes = c(0.1, 10, 30),
#'   note_de_lecture = ""
#' )[["viz"]]

creer_carte_1_1 <- function(data, carto, annee, bornes = NULL, palette = "pal_gouv_o", inverse = TRUE, maille = "EPCI",
                            titre = "\u00c9volution du nombre de logements sociaux par {maille}",
                            note_de_lecture = "", na_label = "Valeurs manquantes", decimales = 0, ...) {

  # récupérer le code de la région à partir du jeu de données
  reg <- data %>%
    dplyr::filter(.data$TypeZone == "R\u00e9gions", .data$Zone_ref == TRUE) %>%
    dplyr::slice(1) %>%
    dplyr::pull("CodeZone") %>%
    as.character()

  # preparer la table à visualiser
  data <- data %>%
    dplyr::filter(.data$millesime == annee) %>%
    mutate(valeur = mapfactory::format_fr(.data$evolution_n_nmoins1, dec = 1, pourcent = FALSE),
           valeur = ifelse(.data$evolution_n_nmoins1 > 0, paste0("+ ", .data$valeur, " %"), paste0(.data$valeur, " %")),
           message_survol = glue::glue("{.data$Zone} : \n {.data$nb_ls_actif} logements en {annee}\n {.data$valeur}"))

  map <- mapfactory::creer_carte(data = data, code_region = reg, carto = carto, maillage = maille, indicateur = evolution_n_nmoins1,
                                 type_viz = "choroplethe", palette = palette, inverse = inverse, interactive = TRUE,
                                 titre = glue::glue(titre), sous_titre = paste("entre ", annee - 1, " et ", annee),
                                 bas_de_page = dplyr::if_else(note_de_lecture != "" ,
                                                              paste0(note_de_lecture, "\n\n", caption(sources = 1, mil_rpls = annee)),
                                                              caption(sources = 1, mil_rpls = annee)),
                                 popover = "{.data$message_survol}",
                                 indicateur_popover = message_survol, decimales = decimales,
                                 evolution = TRUE, suffixe =  " %", na_label = na_label, bornes = bornes, ...)

  # donnees a faire figurer dans l'export xls
  codes_zones_a_garder <- c(COGiter::list_epci_in_reg(reg), COGiter::list_com_in_reg(reg))
  data_xls <- data %>%
    # filtre sur la region et la maille de la carte, attention les noms de mailles dans TypeZone sont légèrement différents du paramètre maille
    dplyr::filter(grepl(tolower(maille), tolower(.data$TypeZone)), .data$CodeZone %in% codes_zones_a_garder) %>%
    dplyr::select("CodeZone", "Zone", "evolution_n_nmoins1", "nb_ls_actif")



  # metadonnees a faire figurer dans la table des matiere de l'export xls
  index <- data.frame(onglet = "carte_1_1", titre = glue::glue(titre))

  return(list(viz = map, tab_xls = data_xls, meta = index))
}

#' Creation du graphique du chapitre sur les caracteristiques du parc, representant la repartition regionale des logements sociaux selon le nb de pieces, en distinguant le parc total du parc recent
#'
#' @description Mise en page du diagramme en bâtons représentant la répartition régionale de l’ensemble des logements sociaux selon le nb de pièces, pour le parc total et le parc récent.
#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref.
#' @param annee Le millesime renseigné par l'utilisateur, au format numérique.
#' @param palette choix de la palette de couleur parmi celle de \code{gouvdown::\link{scale_color_gouv_discrete}}
#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Répartition {dep_reg}e des logements sociaux selon le nombre de pièces au 01/01/{annee}")
#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
#'
#' @return Une liste de 3 objets : un graphique en barres interactives au format html (viz),
#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
#'
#' @importFrom dplyr filter select starts_with mutate group_by ungroup
#' @importFrom forcats fct_relevel
#' @importFrom ggiraph geom_bar_interactive ggiraph
#' @importFrom ggplot2 ggplot aes position_dodge scale_x_discrete scale_y_continuous theme element_blank labs
#' @importFrom gouvdown scale_fill_gouv_discrete
#' @importFrom glue glue
#' @importFrom tidyr pivot_longer
#' @importFrom scales percent
#' @importFrom rlang .data
#' @export
#'
#' @examples
#' indicateurs_rpls_illustrations <- lire_rpls_exemple() %>%
#'  dplyr::filter(Zone_ref)
#'
#' creer_graphe_2_1(data = indicateurs_rpls_illustrations, annee = 2019, note_de_lecture = "")[["viz"]]

creer_graphe_2_1 <- function(data, annee, palette = "pal_gouv_qual2",
                             titre = NULL, note_de_lecture = "") {

  if (is.null(titre)){
    titre <- "R\u00e9partition {dep_reg}e des logements sociaux \nselon le nombre de pi\u00e8ces au 01/01/{annee}"
    }

  creer_graphe_2_1 <- data %>%
    # filtre sur la région et pour le millesime souhaite
    dplyr::filter(.data$TypeZone == "R\u00e9gions" & .data$millesime == annee) %>%
    # selection des variables necessaires au graphe
    dplyr::select("Zone", dplyr::starts_with("nb_piece")) %>%
    # passage au format long de la table en distinguant le nb de piece du type de logement (recent ou pas)
    tidyr::pivot_longer(
      cols = -"Zone", names_to = c("nb_piece", "type"), values_to = "values",
      names_pattern = "(nb_piece_[0-9]_plus|nb_piece_[0-9])[_]{0,1}(.*)"
    ) %>%
    # creation de la modalite parc total
    dplyr::mutate(type = ifelse(.data$type == "", "total", .data$type)) %>%
    dplyr::group_by(.data$type) %>%
    dplyr::mutate(freq = (.data$values / sum(.data$values)) * 100) %>%
    dplyr::ungroup()

  id_reg <- dplyr::filter(data, grepl("gions", .data$TypeZone)) %>%
    dplyr::pull("CodeZone") %>% unique %>% as.character

  dep_reg <- propre.datareg::datareg(code_reg = id_reg)$regional_e


  g_bar <- ggplot2::ggplot(data = creer_graphe_2_1,
                           ggplot2::aes(
                             x = .data$nb_piece,
                             y = .data$freq,
                             fill = forcats::fct_relevel(.data$type, "total", "recent"),
                             # information a faire apparaitre dans les bulles: le nb_ls avec separateur des milliers
                             tooltip = format_fr_pct(.data$freq)
                           )) +
    # geom_bar en version interactif
    ggiraph::geom_bar_interactive(stat = "identity", position = ggplot2::position_dodge()) +
    # gestion des libelles de l axe des abscisses
    ggplot2::scale_x_discrete(
      breaks = c("nb_piece_1", "nb_piece_2", "nb_piece_3", "nb_piece_4", "nb_piece_5_plus"),
      labels = c("1 pi\u00e8ce", "2 pi\u00e8ces", "3 pi\u00e8ces", "4 pi\u00e8ces", "5 pi\u00e8ces et plus")
    ) +
    # gestion des libelles de la legende
    gouvdown::scale_fill_gouv_discrete(palette = palette, breaks = c("total", "recent"),
                                       labels = c("Parc total", "Parc r\u00e9cent (5 ans ou moins)")) +
    # formatage de l axe des ordonnees
    ggplot2::scale_y_continuous(labels = ~format_fr_nb(x = .x, dec = 0)) +
    ggplot2::theme(
      legend.title = ggplot2::element_blank(),
      legend.position = "bottom"
    ) +
    # habillage simple
    ggplot2::labs(
      title = glue::glue(titre),
      subtitle = "Unit\u00e9 : %",
      x = "",
      y = "",
      caption = dplyr::if_else(note_de_lecture != "" ,
                               paste0(note_de_lecture, "\n\n", caption(sources = 1, mil_rpls = annee)),
                               caption(sources = 1, mil_rpls = annee)))

  # transformation par ggiraph
  gbar_inter <- ggiraph::ggiraph(code = print(g_bar))

  # donnees a faire figurer dans l'export xls
  data_xls <- creer_graphe_2_1 %>%
    dplyr::rename("nb_logements" = "values", "pourcentage" = "freq", "type_parc" = "type") %>%
    dplyr::mutate(pourcentage = round(x = .data$pourcentage / 100, digits = 3))

  # metadonnees a faire figurer dans la table des matiere de l'export xls
  index <- data.frame(onglet = "graphe_2_1", titre = glue::glue(titre) %>% gsub("\n", " ", .))

  return(list(viz = gbar_inter, tab_xls = data_xls, meta = index))

}

#' Creation du tableau du chapitre Evolution du parc (nombre de logements sociaux, evolution annuelle, densite...)
#'
#' @description Mise en page du tableau du chapitre 1 au format html.
#'
#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref.
#' @param annee Le millesime renseigné par l'utilisateur.
#' @param epci un booléen pour indiquer si l'on souhaite détailler le tableau par EPCI.
#' @param add_scroll un booleen pour indique si l'on souhaite inserer une scrollbox. (par défaut FALSE)
#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Le parc locatif social {region} au 1er janvier {annee}")
#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
#'
#' @return Une liste de 3 objets : un tableau mis en page au format html (viz),
#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
#'
#' @importFrom dplyr filter select mutate arrange pull
#' @importFrom forcats fct_relevel fct_drop
#' @importFrom glue glue
#' @importFrom kableExtra kable kable_styling row_spec add_header_above add_indent footnote scroll_box
#' @importFrom rlang .data
#' @export
#'
#' @examples
#' indicateurs_rpls_illustrations <- lire_rpls_exemple() %>%
#'  dplyr::filter(Zone_ref)
#'
#' creer_tableau_1_1(data = indicateurs_rpls_illustrations, annee = 2019, epci = TRUE,
#' add_scroll = FALSE, note_de_lecture = "")[["viz"]]
#'

creer_tableau_1_1 <- function(data, annee, epci = TRUE, add_scroll = FALSE, titre ="Le parc locatif social {local} au 1er janvier {annee}", note_de_lecture = ""){

  ch1tab <- data %>%
    # filtre pour ne conserver que l annee n souhaitee par l utilisateur
    dplyr::filter(.data$millesime == annee) %>%
    dplyr::select("TypeZone", "CodeZone", "Zone", "nb_ls_actif", "evolution_n_nmoins1", "densite_ls_rp",
                  "part_ls_qpv", "part_ls_ind", "part_ls_coll", "part_ls_etu") %>% # round 2
    # Modification de l'ordre des levels de la variable TypeZone
    propre.rpls::arrange_zonage()


  if(!epci){
    ch1tab <- dplyr::filter(ch1tab, .data$TypeZone != "Epci")
  }

  # Nom region
  nom_reg <- ch1tab %>%
    dplyr::filter(.data$TypeZone == "R\u00e9gions") %>%
    dplyr::pull("Zone") %>%
    as.character()

  # creation du CC lieu pour exception la Reunion et Mayotte dans le titre du tableau
  ## TODO utiliser propre.datareg
  local <- ifelse(get_id_reg(nom_reg) %in% c("04","06") , paste0("de ", nom_reg), paste0("en ", nom_reg))


  ch1tableau <- ch1tab %>%
    #selection des colonnes souhaitees
    dplyr::select(-"TypeZone", -"CodeZone") %>%
    # Mise en place des titres de colonnes
    kableExtra::kable("html", col.names=c("Zone",glue::glue("Nombre de logements sociaux au 01/01/{annee}"),
                                          glue::glue("\u00c9volution {annee}/{annee-1} (en %)"),
                                          "Densit\u00e9 pour 100 r\u00e9sidences principales",
                                          "Part de logements en QPV<br/>(en %)",
                                          "Part des logements individuels<br/>(en %)",
                                          "Part des logements collectifs<br/>(en %)",
                                          "Part des logements \u00e9tudiants<br/>(en %)"),
                      escape = FALSE,
                      digits = c(0, 0, 1, 1, 1, 1, 1, 1), format.args = list(big.mark = " ", decimal.mark = ","),
                      caption = glue::glue(titre)) %>%
    kableExtra::kable_styling(font_size = 12)%>%
    # Formatage de la ligne "Région" : fond blanc, gras
    kableExtra::row_spec(which(dplyr::pull(ch1tab, "TypeZone") == "R\u00e9gions"), bold = TRUE, background = "#FFFFFF") %>%
    # Formatage des lignes "Départements" : fond gris clair, gras
    kableExtra::row_spec(which(dplyr::pull(ch1tab, "TypeZone") == "D\u00e9partements"), bold = TRUE, background = "#E5E5E5") %>%
    # Formatage des lignes "Epci" et "EPT" : fond blanc, taille 10
    kableExtra::row_spec(which(dplyr::pull(ch1tab, "TypeZone") %in% c("EPT", "Epci")), bold = FALSE, background = "#FFFFFF",
                         font_size = 10) %>%
    # Formatage des lignes "France" : fond gris foncé, gras
    kableExtra::row_spec(which(dplyr::pull(ch1tab, "TypeZone") == "France"), bold = TRUE, background = "#C4C4C4") %>%
    # création d'un chapeau pour les variables de typo ind/col/etudiant
    kableExtra::add_header_above(c(" " = 5, "Type de logement" = 3)) %>%
    ## Ajout d'une indentation pour les lignes "EPT" et "Epci"
    kableExtra::add_indent(which(dplyr::pull(ch1tab, "TypeZone") %in% c("EPT", "Epci"))) %>%
    # Creation note de bas de page avec la source et l ajout parametrable d une note de lecture
    kableExtra::footnote(general = paste0(dplyr::if_else(note_de_lecture != "",
                                                       paste0(note_de_lecture, "\n"),
                                                       ""),
                                        caption(sources = 2, mil_rpls = annee)), general_title = "")

  # insere une scrollbox pour une meilleure lisibilite
  if (add_scroll) {
    ch1tableau <- ch1tableau %>%
      kableExtra::scroll_box(width = "100%", height = "500px", fixed_thead = TRUE)
  }

  # metadonnees a faire figurer dans la table des matiere de l'export xls
  index <- data.frame(onglet = "tableau_1_1", titre = glue::glue(titre))

  return(list(viz = ch1tableau, tab_xls = ch1tab, meta = index))

}

#' Chapitre 3: Verbatim
#'
#' @description Production des commentaires verbatim du chapitre 3.

#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref
#' @param annee Le millesime renseigné par l'utilisateur (au format numérique)
#'
#' @return Un vecteur de 4 chaînes de caractères comprenant l'intertitre, les commentaires, le titre et le texte de l encadre du chapitre 3
#'
#' @importFrom dplyr filter arrange slice mutate case_when pull
#' @importFrom glue glue
#' @importFrom propre.datareg datareg maj1let
#' @importFrom rlang .data
#'
#' @export
#'
#' @examples
#' indic_rpls_ref <- propre.rpls::lire_rpls_exemple() %>%
#'  dplyr::filter(Zone_ref)
#' verbatim3 <- creer_verbatim_3(data = indic_rpls_ref, annee = 2019)
#' verbatim3$encadre_paragraphe


creer_verbatim_3 <- function(data, annee) {

  # on calcule d'abord les indicateurs necessaires aux commentaires
  mise_en_serv <- data %>%
    dplyr::filter(grepl("gions", .data$TypeZone)) %>%
    dplyr::arrange(desc(.data$millesime)) %>%
    dplyr::slice(1:5) %>%
    dplyr::mutate(rang = rank(.data$nb_mes, na.last = TRUE, ties.method = "first")) %>%
    dplyr::mutate(class_mes = dplyr::case_when(
      .data$rang == 1 ~  "du plus faible volume",
      .data$rang == 2 ~  "du deuxi\u00e8me plus faible volume",
      .data$rang == 3 ~  "du volume m\u00e9dian",
      .data$rang == 4 ~  "du deuxi\u00e8me plus important volume",
      .data$rang == 5 ~  "du plus important volume",
      TRUE ~ "")
    ) %>%
    dplyr::filter(.data$millesime == annee) %>%
    dplyr::mutate(pourc_lgt_neuf = ((.data$nb_mes_qpv_construit_org + .data$nb_mes_qpv_acq_vefa + .data$nb_mes_nonqpv_construit_org + .data$nb_mes_nonqpv_acq_vefa) / .data$nb_mes * 100) %>% format_fr_pct,
                  pourc_lgt_neuf_cons = ((.data$nb_mes_qpv_construit_org + .data$nb_mes_nonqpv_construit_org) / .data$nb_mes * 100) %>% format_fr_pct ,
                  pourc_lgt_neuf_vefa = ((.data$nb_mes_qpv_acq_vefa + .data$nb_mes_nonqpv_acq_vefa) / .data$nb_mes * 100) %>% format_fr_pct,
                  pourc_lgt_acquis = ((.data$nb_mes_qpv_acq_av_travaux + .data$nb_mes_qpv_acq_ss_travaux + .data$nb_mes_nonqpv_acq_av_travaux + .data$nb_mes_nonqpv_acq_ss_travaux) / .data$nb_mes * 100) %>% format_fr_pct,
                  pourc_rehab = ((.data$nb_mes_qpv_acq_av_travaux + .data$nb_mes_nonqpv_acq_av_travaux) / (.data$nb_mes_qpv_acq_av_travaux + .data$nb_mes_qpv_acq_ss_travaux + .data$nb_mes_nonqpv_acq_av_travaux + .data$nb_mes_nonqpv_acq_ss_travaux) * 100) %>% format_fr_pct,
                  nb_mes_acq_ss_travaux = .data$nb_mes_qpv_acq_ss_travaux + .data$nb_mes_nonqpv_acq_ss_travaux,
                  nb_mes_acq_av_travaux = .data$nb_mes_qpv_acq_av_travaux + .data$nb_mes_nonqpv_acq_av_travaux)

  annee_prec <- data %>%
    dplyr::filter(grepl("gions", .data$TypeZone), .data$millesime == annee - 1)

  mes_acq <- dplyr::case_when((mise_en_serv$nb_mes_acq_ss_travaux + mise_en_serv$nb_mes_acq_av_travaux) == 0 ~ 0,
                              mise_en_serv$nb_mes_acq_av_travaux == 0 ~ 1,
                              TRUE ~ 2)


  # on récupère les formulations idiomatiques grâce à {propre.datareg}
  id_reg <- dplyr::filter(data, grepl("gions", .data$TypeZone)) %>%
    dplyr::pull("CodeZone") %>% unique %>% as.character
  verb_reg <- propre.datareg::datareg(code_reg = id_reg)


  # on cree ensuite une liste nommee des differents parametres
  verb3 <- list(nom_reg = verb_reg$dans_la_region_nom_region,
                annee_prec = annee - 1,
                nb_mes = mise_en_serv$nb_mes %>%
                  format_fr_nb(dec = 0, big_mark = " "),
                class_mes = mise_en_serv$class_mes,
                pourc_lgt_neuf = mise_en_serv$pourc_lgt_neuf,
                pourc_lgt_neuf_cons = mise_en_serv$pourc_lgt_neuf_cons,
                pourc_lgt_neuf_vefa = mise_en_serv$pourc_lgt_neuf_vefa,
                pourc_lgt_acquis = mise_en_serv$pourc_lgt_acquis,
                pourc_rehab = mise_en_serv$pourc_rehab,
                nb_ls_actif_n = mise_en_serv$nb_ls_actif %>%
                  format_fr_nb(dec = 0, big_mark = " "),
                nb_ls_actif_n_1 = annee_prec$nb_ls_actif %>%
                  format_fr_nb(dec = 0, big_mark = " "),
                nb_demolition = mise_en_serv$nb_demolition %>%
                  format_fr_nb(dec = 0, big_mark = " "),
                nb_ventes = mise_en_serv$nb_ventes %>%
                  format_fr_nb(dec = 0, big_mark = " "),
                nb_sorties_autres_motifs= mise_en_serv$nb_sorties_autres_motifs %>%
                  format_fr_nb(dec = 0, big_mark = " "),
                nb_vente_bailleur = mise_en_serv$nb_vente_bailleur %>%
                  format_fr_nb(dec = 0, big_mark = " "))


  # production du verbatim a partir des elements precedents
  verbatim_chap_3 <- list(intertitre = "", commentaires = "", encadre_titre = "", encadre_paragraphe= "")
  verbatim_chap_3$intertitre <- glue::glue("En {verb3$annee_prec}, {verb3$nb_mes} logements sociaux ont \u00e9t\u00e9 mis en service")
  verbatim_chap_3$commentaires <- glue::glue("Entre le 2 janvier {verb3$annee_prec} et le 1er janvier {annee}, ",
                                             "{verb3$nb_mes} logements sociaux ont \u00e9t\u00e9 mis en service {verb3$nom_reg}. ",
                                             "Il s\u0027agit {verb3$class_mes} constat\u00e9 sur les cinq derni\u00e8res ann\u00e9es. ",
                                             "Parmi ces mises en service, {verb3$pourc_lgt_neuf} sont des logements neufs, ",
                                             "c\u0027est-\u00e0-dire construits par l\u0027organisme ({verb3$pourc_lgt_neuf_cons}) ",
                                             "ou acquis en vente en l\u0027\u00e9tat futur d\u0027ach\u00e8vement ({verb3$pourc_lgt_neuf_vefa}).")

  if (mes_acq == 0) {
    verbatim_chap_3$commentaires <- glue::glue(
      verbatim_chap_3$commentaires,
      " En {verb3$annee_prec}, aucun bailleur n\u0027a mis en service de logement acquis dans le parc priv\u00e9."
      )
  } else {
    verbatim_chap_3$commentaires <- glue::glue(
      verbatim_chap_3$commentaires,
      " Les logements mis en service peuvent \u00eatre \u00e9galement des logements existants acquis en dehors du parc social. ",
      "Les acquisitions dans le parc priv\u00e9 repr\u00e9sentent {verb3$pourc_lgt_acquis} des mises en service en {verb3$annee_prec}"
      )
  }

  if (mes_acq == 1) { verbatim_chap_3$commentaires <- glue::glue(verbatim_chap_3$commentaires, ".")}
  if (mes_acq == 2) {
    verbatim_chap_3$commentaires <- glue::glue(verbatim_chap_3$commentaires,
                                               " ; {verb3$pourc_rehab} d\u0027entre elles se font avec des travaux de r\u00e9habilitation.")}

  verbatim_chap_3$encadre_titre <- glue::glue("Les mouvements du parc en {verb3$annee_prec}")
  verbatim_chap_3$encadre_paragraphe <- glue::glue(
    '{propre.datareg::maj1let(verb3$nom_reg)}, le nombre de logements sociaux est de {verb3$nb_ls_actif_n} au 1er janvier {annee} contre {verb3$nb_ls_actif_n_1} au 1er janvier {verb3$annee_prec}.
                                                  Au cours de l\u0027ann\u00e9e {verb3$annee_prec}, {verb3$nb_mes} logements sociaux ont \u00e9t\u00e9 mis en service dans la r\u00e9gion. Dans le m\u00eame temps, {ifelse(verb3$nb_demolition>0,verb3$nb_demolition,"")}{ifelse(verb3$nb_demolition == 1," logement a \u00e9t\u00e9 d\u00e9moli, ","")}{ifelse(verb3$nb_demolition>1," logements ont \u00e9t\u00e9 d\u00e9molis, ","")}{ifelse(verb3$nb_ventes>0,verb3$nb_ventes,"")}{ifelse(verb3$nb_ventes == 1," logement a \u00e9t\u00e9 vendu","")}{ifelse(verb3$nb_ventes>1," logements ont \u00e9t\u00e9 vendus","")}{ifelse(verb3$nb_sorties_autres_motifs>0,", et ","")}{ifelse(verb3$nb_sorties_autres_motifs>0,verb3$nb_sorties_autres_motifs,"")}{ifelse(verb3$nb_sorties_autres_motifs == 1," logement a chang\u00e9 d\u0027usage ou a \u00e9t\u00e9 restructur\u00e9","")}{ifelse(verb3$nb_sorties_autres_motifs>1," logements ont chang\u00e9 d\u0027usage ou ont \u00e9t\u00e9 restructur\u00e9s","")}.
                                                  {ifelse(verb3$nb_vente_bailleur>0,"Sans incidence sur le nombre de logements du parc social, ","")}{ifelse(verb3$nb_vente_bailleur>0,verb3$nb_vente_bailleur,"")}{ifelse(verb3$nb_vente_bailleur == 1," logement a fait l\u0027objet d\u0027un transfert entre bailleurs. ","")}{ifelse(verb3$nb_vente_bailleur>1," logements ont fait l\u0027objet d\u0027un transfert entre bailleurs. ","")}'
  )


  verbatim_chap_3
}


#' Creation de la 1ere carte du chapitre sur la tension du parc, representant le taux de vacance structurelle par EPCI.
#'
#' @description Création de la carte représentant le taux de vacance structurelle par EPCI pour l'année N choisie.
#'
#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur.
#' @param annee Une année parmi les millésimes sélectionnables par l'utilisateur, au format numérique.
#' @param carto La table des fonds de carte realisee avec \code{mapfactory::\link{fond_carto}}.
#' @param bornes Les bornes manuelles de la légende, mettre à NULL pour utiliser la méthode par défaut (quantile).
#' @param palette choix de la palette de couleurs parmi celle de \code{gouvdown::\link{scale_color_gouv_discrete}}
#' @param inverse choix du sens de la progression des couleurs : du plus foncé au plus clair (FALSE) ou du plus clair au plus foncé (TRUE)
#' @param maille le maillage souhaite pour la carte, a choisir parmi "commune", "EPCI" ou "département". "EPCI" par defaut.
#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Taux de vacance structurelle par {maille} au 1er janvier {annee}")
#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
#' @param na_label L'etiquette à afficher dans la legende pour les valeurs manquantes ("Valeurs manquantes" par défaut).
#' @param ... autres paramètres de la fonction[\code{mapfactory::creer_carte}](https://dreal-pdl.gitlab-pages.din.developpement-durable.gouv.fr/csd/mapfactory/reference/creer_carte.html).
#'
#' @return Une liste de 3 objets : une carte choroplethe mise en page au format html (viz),
#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
#'
#' @importFrom dplyr filter slice pull if_else select
#' @importFrom glue glue
#' @importFrom mapfactory creer_carte
#' @importFrom stringr str_wrap
#' @importFrom COGiter list_epci_in_reg list_com_in_reg
#'
#' @export
#'
#' @examples
#' indic_rpls <- lire_rpls_exemple()
#'
#' creer_carte_5_1(
#'   data = indic_rpls,
#'   annee = 2019,
#'   carto = mapfactory::fond_carto("Corse"),
#'   bornes = NULL,
#'   note_de_lecture = ""
#' )[["viz"]]

creer_carte_5_1 <- function(data, annee, carto, bornes = NULL, palette = "pal_gouv_o", inverse = FALSE, maille = "EPCI",
                            titre = "Taux de vacance structurelle par {maille} au 1er janvier {annee}",
                            note_de_lecture = "", na_label = "Valeurs manquantes", ...) {

  # récupérer le code de la région à partir du jeu de données
  reg <- data %>%
    dplyr::filter(.data$TypeZone == "R\u00e9gions", .data$Zone_ref == TRUE) %>%
    dplyr::slice(1) %>%
    dplyr::pull("CodeZone") %>%
    as.character()

  # preparer la table à visualiser
  data <- data %>%
    dplyr::filter(.data$millesime == annee)

  map <- mapfactory::creer_carte(data = data, code_region = reg, carto = carto, maillage = maille, indicateur = taux_vacance_str,
                                 type_viz = "choroplethe", palette = palette, inverse = inverse, interactive = TRUE,
                                 titre = stringr::str_wrap(glue::glue(titre), width = 30), decimales = 1,
                                 bas_de_page = dplyr::if_else(note_de_lecture != "" ,
                                                              paste0(note_de_lecture, "\n\n", caption(sources = 1, mil_rpls = annee)),
                                                              caption(sources = 1, mil_rpls = annee)),
                                 evolution = FALSE, suffixe =  " %", na_label = na_label, bornes = bornes, ...)

  # donnees a faire figurer dans l'export xls
  codes_zones_a_garder <- c(COGiter::list_epci_in_reg(reg), COGiter::list_com_in_reg(reg))
  data_xls <- data %>%
    # filtre sur la region et la maille de la carte, attention les noms de mailles dans TypeZone sont légèrement différents du paramètre maille
    dplyr::filter(grepl(tolower(maille), tolower(.data$TypeZone)), .data$CodeZone %in% codes_zones_a_garder) %>%
    dplyr::select("CodeZone", "Zone", "taux_vacance_str")

  # metadonnees a faire figurer dans la table des matiere de l'export xls
  index <- data.frame(onglet = "carte_5_1", titre = glue::glue(titre))

  return(list(viz = map, tab_xls = data_xls, meta = index))

}

#' Creation du tableau du chapitre sur les mises en service et les sorties.
#'
#' @description Création du tableau 1 du chapitre 3 en html.
#'
#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref.
#' @param annee Une année parmi les millesimes sélectionnables par l'utilisateur, au format numerique.
#' @param epci un booléen pour indiquer si l'on souhaite détailler le tableau par EPCI.
#' @param add_scroll un booleen pour indique si l'on souhaite inserer une scrollbox.  (par défaut FALSE)
#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Les mouvements (mises en service et sorties) opérés {region} en {annee-1}")
#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
#'
#' @return Une liste de 3 objets : un tableau mis en page au format html (viz),
#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
#'
#' @importFrom dplyr filter select mutate left_join arrange pull
#' @importFrom forcats fct_relevel fct_drop
#' @importFrom kableExtra kable kable_styling row_spec add_indent add_header_above footnote scroll_box
#' @importFrom tidyr pivot_wider
#' @importFrom glue glue
#' @importFrom rlang .data
#'
#' @export
#'
#' @examples
#' indicateurs_rpls_illustrations <- lire_rpls_exemple() %>%
#'  dplyr::filter(Zone_ref)
#'
#' creer_tableau_3_1(data = indicateurs_rpls_illustrations, annee = 2019, epci = FALSE,
#' add_scroll = FALSE, note_de_lecture = "")[["viz"]]

creer_tableau_3_1 <- function(data, annee, epci = FALSE, add_scroll = FALSE, note_de_lecture = "",
                              titre ="Les mouvements (mises en service et sorties) op\u00e9r\u00e9s {local} en {annee-1}"){

  # Création du dataset utile pour la production du tableau
  tab <- data %>%
    # Filtre sur l'année N et N-1
    dplyr::filter(.data$millesime %in% c(annee,annee-1)) %>%
    # Sélection des variables
    dplyr::select("TypeZone", "Zone", "CodeZone", "millesime", "nb_ls_actif") %>%
    # Modification des modalités de la variable "millesime"
    dplyr::mutate(millesime = ifelse(.data$millesime == annee,"n","n_moins1")) %>%
    # Passage du format long au format large (millesime)
    tidyr::pivot_wider(names_from = "millesime", names_prefix = "nb_ls_actif_", values_from = "nb_ls_actif") %>%
    # Jointure avec les autres variables utiles
    dplyr::left_join(data %>%
                       # Filtre sur l'annee N
                       dplyr::filter(.data$millesime == annee) %>%
                       # Sélection des variables utiles
                       dplyr::select("TypeZone", "Zone", "CodeZone", "millesime", "nb_mes", "nb_ventes",
                                     "nb_vente_bailleur", "nb_demolition", "nb_sorties_autres_motifs"),
                     by = c("TypeZone", "Zone", "CodeZone")) %>%
    # Modification de l'ordre des levels de la variable TypeZone
    dplyr::mutate(nb_rattra_omiss = .data$nb_ls_actif_n - .data$nb_ls_actif_n_moins1 - .data$nb_mes + .data$nb_ventes +
                    .data$nb_demolition + .data$nb_sorties_autres_motifs) %>%
    # Tri de la table pour faire apparaitre dans l'ordre FM/Région/Département/EPT/EPCI par nature puis par ordre alphabetique
    propre.rpls::arrange_zonage()


  if(!epci){
    tab <- dplyr::filter(tab, .data$TypeZone != "Epci")
  }

  # Nom region
  nom_reg <- tab %>%
    dplyr::filter(.data$TypeZone == "R\u00e9gions") %>%
    dplyr::pull("Zone") %>%
    as.character()

  # creation du CC lieu pour exception la Reunion et Mayotte dans le titre du tableau
  local <- ifelse(get_id_reg(nom_reg) %in% c("04","06") , paste0("\u00e0 ", nom_reg), paste0("en ", nom_reg))

  # Création du tableau
  tableau <- tab %>%
    # Sélection des variables utiles
    dplyr::select("Zone", "nb_ls_actif_n", "nb_ls_actif_n_moins1", "nb_mes", "nb_ventes", "nb_demolition",
                  "nb_sorties_autres_motifs", "nb_rattra_omiss", "nb_vente_bailleur") %>%
    # Mise en place des titres de colonnes
    kableExtra::kable("html", col.names=c("Zone",
                                          paste0("Logements sociaux au 01/01/", annee),
                                          paste0("Logements sociaux au 01/01/", annee-1),
                                          "Mises en service",
                                          "Ventes\u00a0*",
                                          "D\u00e9molitions",
                                          "Sorties pour un autre motif\u00a0**",
                                          "Rattrapages et omis- sions\u00a0***",
                                          "Transferts \u00e0 un autre bail- leur\u00a0****"),
                      format.args=list(big.mark=" "),
                      caption = glue::glue(titre)) %>%
    # Formatage de la taille des caractères
    kableExtra::kable_styling(font_size = 10) %>%
    # Formatage de la ligne "R\u00e9gion" : fond blanc, gras
    kableExtra::row_spec(which(dplyr::pull(tab, "TypeZone") == "R\u00e9gions"), bold = TRUE, background = "#FFFFFF") %>%
    # Formatage des lignes "D\u00e9partements" : fond gris clair, gras
    kableExtra::row_spec(which(dplyr::pull(tab, "TypeZone") == "D\u00e9partements"), bold = TRUE, background = "#E5E5E5") %>%
    # Formatage des lignes "EPT" et "EPCI" : fond blanc, taille 9
    kableExtra::row_spec(which(dplyr::pull(tab, "TypeZone") %in% c("EPT", "Epci")), bold = FALSE, background = "#FFFFFF",
                         font_size = 9) %>%
    # Ajout d'une indentation pour les lignes "Epci" et "EPT"
    kableExtra::add_indent(which(dplyr::pull(tab, "TypeZone") %in% c("EPT", "Epci"))) %>%
    # Formatage des lignes "France" : fond gris foncé, gras
    kableExtra::row_spec(which(dplyr::pull(tab, "TypeZone") == "France"), bold = TRUE, background = "#C4C4C4") %>%
    # Formatage des largeurs des colonnes : 5, 6, 7, 8 et 9
    kableExtra::column_spec(column = 5, width = "1.8cm") %>%
    kableExtra::column_spec(column = 6, width = "1.8cm") %>%
    kableExtra::column_spec(column = 7, width = "2.2cm") %>%
    kableExtra::column_spec(column = 8, width = "2.2cm") %>%
    kableExtra::column_spec(column = 9, width = "2.2cm") %>%
    # création d'un chapeau pour les variables relatives aux sorties
    kableExtra::add_header_above(c(" " = 4, "Sorties" = 3, " " = 2)) %>%
    # Création note de bas de page avec la source et l ajout parametrable d une note de lecture
    kableExtra::footnote(general = paste0("\n* Ventes \u00e0 l'occupant et autres ventes.
                                          ** Logements fusionn\u00e9s, logements scind\u00e9s ou logements sortis pour autre motif.
                                          *** \u00c9carts observ\u00e9s entre les d\u00e9clarations des bailleurs sociaux entre ",
                                          annee-1, " et ", annee, ", tant vis-\u00e0-vis des sorties que des entr\u00e9es dans le parc social.
                                          **** Les logements transf\u00e9r\u00e9s d'un bailleur \u00e0 un autre restent actifs dans le r\u00e9pertoire.
                                          \n",
                                          dplyr::if_else(note_de_lecture != "",
                                                         paste0(note_de_lecture, "\n"),
                                                         ""),
                                          caption(sources = 1, mil_rpls = annee)), general_title = " ")


  # insere une scrollbox pour une meilleure lisibilite
  if (add_scroll) {
    tableau <- tableau %>%
      kableExtra::scroll_box(width = "100%", height = "500px", fixed_thead = TRUE)
  }

  # donnees a faire figurer dans l'export xls
  data_xls <- tab %>%
    dplyr::select("Zone", "nb_ls_actif_n", "nb_ls_actif_n_moins1", "nb_mes", "nb_ventes", "nb_demolition",
                  "nb_sorties_autres_motifs", "nb_rattra_omiss", "nb_vente_bailleur") %>%
    dplyr::rename("nb_mise_en_service" = "nb_mes")

  # metadonnees a faire figurer dans la table des matiere de l'export xls
  index <- data.frame(onglet = "tableau_3_1", titre = glue::glue(titre))

  return(list(viz = tableau, tab_xls = data_xls, meta = index))



}

#' Creation de deux graphiques du chapitre anciennete et etat energetique, represantant la repartition des logements selon la classe DPE energie (A a G) et selon la classe DPE effet de serre (A a G).
#'
#' @description Création de deux diagrammes en barres représentant le pourcentage de logements selon les étiquettes DPE (de A à G) pour
#' la consommation d'énergie et les émissions de gaz à effet de serre à l'échelle régionale.
#'
#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref.
#' @param annee Une année parmi les millésimes sélectionnables par l'utilisateur, au format numérique.
#' @param titre_nrj une chaine de caractère si vous voulez ajouter un titre spécifique au graphe sur le dpe energie. (par défaut: "Répartition des logements selon leur classe de consommation d'énergie au 1er janvier {annee}")
#' @param titre_effet_serre une chaine de caractère si vous voulez ajouter un titre spécifique au graphe sur le dpe CO2 (par défaut: "Répartition des logements selon leur classe d'impact des consommations d'énergie sur l'effet de serre au 1er janvier {annee}")
#' @param note_de_lecture_nrj une chaine de caractère si voulez faire une note de lecture au 1er graph sur le dpe energie
#' @param note_de_lecture_effet_serre une chaine de caractère si voulez faire une note de lecture au 2e graph sur le dpe CO2
#'
#' @return une composition de deux graphiques en barres interactifs pour les régions métropolitaines, rien sinon
#' @return Une liste de 3 objets : une composition de 2 graphiques en barres interactifs pour les régions métropolitaines, vide sinon (viz),
#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).

#'
#' @importFrom dplyr filter select mutate pull group_by
#' @importFrom ggiraph geom_bar_interactive ggiraph
#' @importFrom ggplot2 ggplot aes position_dodge labs guides guide_legend theme scale_fill_discrete scale_fill_manual coord_flip geom_text element_blank scale_y_continuous
#' @importFrom gouvdown scale_fill_gouv_discrete
#' @importFrom stringr str_wrap
#' @importFrom tidyr pivot_longer
#' @importFrom rlang .data
#' @importFrom forcats fct_relevel fct_rev
#' @importFrom scales percent
#' @importFrom patchwork plot_layout
#' @importFrom glue glue
#' @export
#'
#' @examples
#' indicateurs_rpls_illustrations <- lire_rpls_exemple() %>%
#'  dplyr::filter(Zone_ref)
#'
#' creer_graphe_4_1(data = indicateurs_rpls_illustrations, annee = 2019,
#'  note_de_lecture_nrj = "",
#'  note_de_lecture_effet_serre = "")[["viz"]]


creer_graphe_4_1 <- function(data, annee,
                             titre_nrj = NULL,
                             titre_effet_serre = NULL,
                             note_de_lecture_nrj = "",
                             note_de_lecture_effet_serre = ""){
  caption_champ <- "Champ : logements ayant un DPE renseign\u00e9 et \nr\u00e9alis\u00e9 avant le 1er juillet 2021\n\n"
  if (is.null(titre_nrj)){
    titre_nrj <- "R\u00e9partition des logements selon leur classe de consommation d'\u00e9nergie au 1er janvier {annee}"}
  if (is.null(titre_effet_serre)){
    titre_effet_serre <- "R\u00e9partition des logements selon leur classe d'impact des consommations d'\u00e9nergie sur l'effet de serre au 1er janvier {annee}"}
  # un booleen pour l'appartenance de la région à la France métropolitaine
  metro <- dplyr::filter(data, grepl("FRMETRO", .data$CodeZone)) %>%
    dplyr::pull("CodeZone") %>% unique() %>%
    as.character() == "FRMETRO"

  # la fonction ne renvoie rien si la région choisie est DROM
  if(metro) {
    # Création du dataset utile à la production du graphique
    tab <- data %>%
      # Filtre pour ne garder que les données de la région choisie et du millésime sélectionné
      dplyr::filter(.data$TypeZone == "R\u00e9gions",
                    .data$millesime == annee) %>%
      # Sélection des variables utiles pour le graphique
      dplyr::select("TypeZone", "Zone", "millesime",
                    "nb_ls_dpe_ener_A", "nb_ls_dpe_ener_B", "nb_ls_dpe_ener_C", "nb_ls_dpe_ener_D",
                    "nb_ls_dpe_ener_E", "nb_ls_dpe_ener_F", "nb_ls_dpe_ener_G",
                    "nb_ls_dpe_serre_A", "nb_ls_dpe_serre_B", "nb_ls_dpe_serre_C", "nb_ls_dpe_serre_D",
                    "nb_ls_dpe_serre_E", "nb_ls_dpe_serre_F", "nb_ls_dpe_serre_G") %>%
      # Passage du format large au format long
      tidyr::pivot_longer(-c("TypeZone", "Zone", "millesime"),
                          values_to = "Nb_logements", names_sep = "_", names_to = c("Type_dpe", "Classe_dpe"),
                          names_prefix = "nb_ls_dpe_") %>%
      # Modification des modalités de la variable Type_dpe
      dplyr::mutate(Type_dpe = ifelse(.data$Type_dpe == "ener", "Classe \u00c9nergie", "Classe Effet de serre"),
                    # Modification de l'ordre des levels
                    Type_dpe = forcats::fct_relevel(.data$Type_dpe, "Classe \u00c9nergie", "Classe Effet de serre")) %>%
      dplyr::group_by(.data$Type_dpe) %>%
      dplyr::mutate(Percent_logements = 100 * prop.table(.data$Nb_logements))


    ymax = max(dplyr::pull(tab,"Percent_logements")) + 30

    # Création du graphique ENERGIE
    tab1 <- tab %>%
      dplyr::filter(.data$Type_dpe == "Classe \u00c9nergie")

    graphe1 <- ggplot2::ggplot(data = tab1, mapping = ggplot2::aes(x = forcats::fct_rev(factor(.data$Classe_dpe)),
                                                                   y = .data$Percent_logements, fill = .data$Classe_dpe)) +
      # Création graphique en barres en mode interactif
      ggiraph::geom_bar_interactive(stat = "identity", data_id = row.names(tab1),
                                    tooltip = dplyr::pull(tab1, "Percent_logements") %>% format_fr_pct(),
                                    position = ggplot2::position_dodge()) +
      ggplot2::coord_flip() +
      ggplot2::geom_label(ggplot2::aes(label = format_fr_pct(.data$Percent_logements)),
                          vjust = 0.3, hjust = -0.2 , size = 3.5, label.size = 0, fill = "white") +
      ggplot2::geom_label(ggplot2::aes(x = forcats::fct_rev(factor(.data$Classe_dpe)), y = ymax), hjust = "right", label.size = 0, fill = "white",
                          label = c("\u2264 50 kWh/m\u00b2 par an","51 \u00e0 90","91 \u00e0 150","151 \u00e0 230","231 \u00e0 330","331 \u00e0 450","> 450")) +
      # Paramétrage titre, sous-titre, axes ...
      ggplot2::labs(title = stringr::str_wrap(glue::glue(titre_nrj), width = 50),
                    subtitle = "Unit\u00e9 : %",
                    x = "",
                    y = "",
                    caption = dplyr::if_else(note_de_lecture_nrj != "" ,
                                             paste0(note_de_lecture_nrj, "\n", caption_champ, caption(sources = 1, mil_rpls = annee)),
                                             paste0(caption_champ, caption(sources = 1, mil_rpls = annee)))) +
      # Retrait du titre de la légende
      ggplot2::guides(fill = ggplot2::guide_legend(title = "")) +
      # Positionnement de la légende sous le graphique
      ggplot2::theme(legend.position = "none",
                     axis.text.x = ggplot2::element_blank(),
                     axis.ticks.x = ggplot2::element_blank()) +
      ggplot2::scale_y_continuous(lim = c(0,ymax))+
      ggplot2::scale_fill_manual(breaks = c("A", "B", "C", "D", "E", "F", "G"),
                                 values = c("#319A31","#33CC33","#CCFF33","#FFFF00","#FFCC00","#FF9A33","#ff0000"))

    # Création du graphique GES
    tab2 <- tab %>%
      dplyr::filter(.data$Type_dpe == "Classe Effet de serre")

    graphe2 <- ggplot2::ggplot(data = tab2, mapping = ggplot2::aes(x = forcats::fct_rev(factor(.data$Classe_dpe)),
                                                                   y = .data$Percent_logements, fill = .data$Classe_dpe)) +
      # Création graphique en barres en mode interactif
      ggiraph::geom_bar_interactive(stat = "identity", data_id = row.names(tab2),
                                    tooltip = dplyr::pull(tab2, "Percent_logements") %>% format_fr_pct(),
                                    position = ggplot2::position_dodge()) +
      ggplot2::coord_flip()+
      ggplot2::geom_label(ggplot2::aes(label = format_fr_pct(.data$Percent_logements)),
                          vjust = 0.3, hjust = -0.2 , size = 3.5, label.size = 0, fill = "white") +
      ggplot2::geom_label(ggplot2::aes(x = forcats::fct_rev(factor(.data$Classe_dpe)), y = ymax), hjust = "right",
                          label.size = 0, fill = "white",
                          label = c("\u2264 5 kg eq CO2/m\u00b2 par an", "6 \u00e0 10","11 \u00e0 20","21 \u00e0 35",
                                    "36 \u00e0 55", "56 \u00e0 80","> 80")) +
      # Paramétrage titre, sous-titre, axes ...
      ggplot2::labs(title = stringr::str_wrap(glue::glue(titre_effet_serre), width = 50),
                    subtitle = "Unit\u00e9 : %",
                    x = "",
                    y = "",
                    caption = dplyr::if_else(note_de_lecture_effet_serre != "" ,
                                             paste0(note_de_lecture_effet_serre, "\n", caption_champ, caption(sources = 1, mil_rpls = annee)),
                                             paste0(caption_champ, caption(sources = 1, mil_rpls = annee)))) +
      # Retrait du titre de la légende
      ggplot2::guides(fill = ggplot2::guide_legend(title = "")) +
      # Positionnement de la légende sous le graphique
      ggplot2::theme(legend.position = "none",
                     axis.text.x = ggplot2::element_blank(),
                     axis.ticks.x = ggplot2::element_blank())  +
      ggplot2::scale_y_continuous(lim = c(0, ymax))+
      ggplot2::scale_fill_manual(breaks = c("A", "B", "C", "D", "E", "F", "G"),
                                 values = c("#F6EDFD","#E1C2F8","#D4A9F5","#CB95F3","#BA72EF","#A74DEB","#8A19DF"))

    #Patchwork des graphiques
    g <- graphe1 + graphe2 + patchwork::plot_layout(ncol = 1)

    # Ajout de l'interactivité
    graphe <- ggiraph::ggiraph(ggobj = g, width_svg = 6, height_svg = 10)

    # donnees a faire figurer dans l'export xls
    data_xls <- dplyr::select(tab, -"TypeZone")

    # metadonnees a faire figurer dans la table des matiere de l'export xls
    index <- data.frame(onglet = "graphe_4_1", titre = glue::glue("R\u00e9partition des logements selon leur DPE au 1er janvier {annee}"))

    return(list(viz = graphe, tab_xls = data_xls, meta = index))


  } else {
    return(list(viz = NULL, tab_xls = NULL, meta = NULL))
  }
}

#' Trier les zonages pour les tableaux
#' Cette fonction permet de trier les zonages des tableaux dans l'ordre suivant : region, departements, epci, totaux France et DROM.
#' Les epci sont tries par nature d'epci.
#'
#' @param data le dataframe en entrée
#'
#' @return un dataframe
#' @importFrom dplyr select mutate bind_rows across inner_join arrange case_when everything
#' @importFrom forcats fct_inorder fct_drop
#' @export
#'
#' @examples
#'indicateurs_rpls_ref <- lire_rpls_exemple() %>%
#'  dplyr::filter(Zone_ref)
#'indicateurs_rpls_ref <- arrange_zonage(data = indicateurs_rpls_ref)
arrange_zonage <- function(data) {
  liste_zone <- COGiter::liste_zone %>%
    dplyr::select("TypeZone", "Zone", "CodeZone", "NATURE_EPCI")

  fr <- data.frame(
    TypeZone = c("France", "France", "France", "France"),
    Zone = c("France de province", "D\u00e9partements et r\u00e9gions d'outre-mer", "France m\u00e9tropolitaine", "France m\u00e9tropolitaine et DROM"),
    CodeZone = c("FRPROV", "DROM", "FRMETRO", "FRMETRODROM")
  ) %>%
    dplyr::mutate(dplyr::across(.cols = dplyr::everything(), .fns = ~ forcats::fct_inorder(as.factor(.x))))

  liste_zone_spe <- propre.rpls::zonage_spe %>%
    dplyr::select("TypeZone", "Zone", "CodeZone") %>%
    dplyr::mutate(dplyr::across(dplyr::contains("Zone"), ~forcats::fct_expand(.x, levels(liste_zone$.x)))) %>%
    unique()

  liste_zone <- dplyr::bind_rows(liste_zone, liste_zone_spe) %>%
    dplyr::mutate(CodeZone = forcats::fct_relevel(.data$CodeZone, sort)) %>%
    dplyr::arrange(.data$TypeZone, .data$CodeZone) %>%
    dplyr::bind_rows(fr)

  res <- data %>%
    dplyr::inner_join(liste_zone %>%
      dplyr::select("TypeZone", "Zone", "CodeZone", "NATURE_EPCI")) %>%
    dplyr::mutate(
      TypeZone = forcats::fct_expand(.data$TypeZone, levels(liste_zone$TypeZone)),
      TypeZone = forcats::fct_relevel(.data$TypeZone, "France", "R\u00e9gions", "D\u00e9partements", "EPT", "Epci"),
      var_de_tri = dplyr::case_when(
        .data$TypeZone == "Epci" ~ paste0(as.numeric(.data$NATURE_EPCI), "_",  .data$Zone),
        .data$TypeZone == "EPT" ~  as.character(.data$Zone),
        .data$TypeZone == "D\u00e9partements" ~ as.character(.data$CodeZone),
        TRUE ~ paste0(as.numeric(.data$CodeZone))) # on récupère le n° du facteur
      ) %>%
    dplyr::arrange(.data$TypeZone, .data$var_de_tri) %>%
    dplyr::mutate(
      Zone = forcats::fct_drop(.data$Zone) %>% forcats::fct_inorder(.),
      CodeZone = forcats::fct_drop(.data$CodeZone) %>% forcats::fct_inorder(.)
    ) %>%
    select(-"NATURE_EPCI", -"var_de_tri")
  return(res)
}


#' Creation de deux graphiques du chapitre sur les tensions sur le marche, representant l evolution du taux de vacance et de mobilite ces 5 dernieres annees pour la region et deux territoires supra de comparaison.
#' @description Création de deux graphiques représentant l'évolution du taux de vacance et du taux de mobilité sur 6 ans
#' (de 5 années avant l'année choisie jusqu'à l'année choisie), pour la region et deux territoires supra de comparaison.
#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref.
#' @param annee Une année parmi les millésimes sélectionnables par l'utilisateur, au format numérique.
#' @param palette choix de la palette de couleur parmi celle de \code{gouvdown::\link{scale_color_gouv_discrete}}. Par defaut : "pal_gouv_qual2"
#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Évolution de la vacance et de la mobilité)
#' @param titre_vacance une chaine de caractère si vous voulez ajouter un titre spécifique pour le taux de vacance. (par défaut: "Taux de vacance structurelle")
#' @param titre_mobilite une chaine de caractère si vous voulez ajouter un titre spécifique pour le taux de mobilite. (par défaut: "Taux de mobilité")

1		#' Creation du tableau sur l anciennete du parc (chapitre anciennete et etat energetique).
2		#'
3		#' @description Création du tableau 1 du chapitre 4 en html.
4		#'
5		#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref.
6		#' @param annee Une année parmi les millesimes sélectionnables par l'utilisateur, au format numerique.
7		#' @param epci un booléen pour indiquer si l'on souhaite détailler le tableau par EPCI.
8		#' @param add_scroll un booleen pour indique si l'on souhaite inserer une scrollbox. (par défaut FALSE)
9		#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Répartition des logements sociaux selon leur ancienneté au 1er janvier {annee}")
10		#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
11		#'
12		#' @return Une liste de 3 objets : un graphique en courbes interactif au format html (viz),
13		#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
14		#'
15		#' @importFrom dplyr filter mutate arrange select pull ends_with starts_with
16		#' @importFrom forcats fct_relevel
17		#' @importFrom glue glue
18		#' @importFrom kableExtra kable kable_styling row_spec add_indent footnote scroll_box
19		#' @importFrom rlang .data
20		#'
21		#' @export
22		#'
23		#' @examples
24		#' indicateurs_rpls_illustrations <- lire_rpls_exemple() %>%
25		#' dplyr::filter(Zone_ref)
26		#'
27		#' creer_tableau_4_1(data = indicateurs_rpls_illustrations, annee = 2019, epci = FALSE,
28		#' add_scroll = FALSE, note_de_lecture = "")[["viz"]]
29
30
31		creer_tableau_4_1 <- function(data, annee, epci = FALSE,
32		add_scroll = FALSE,
33		titre = NULL,
34		note_de_lecture = ""){
35
36	1x	if (is.null(titre)){
37	1x	titre <- "R\u00e9partition des logements sociaux selon leur anciennet\u00e9<br>au 1er janvier {annee}"}
38
39		# une fonction de calcul et de formatage des pourcentages du tableau
40	1x	mef <- function(x, y) {
41	6x	round(x / y * 100, 1) %>%
42	6x	format_fr_pct()
43		}
44
45	1x	deformat <- function(x = format_fr_pct(0.10)) {
46	6x	gsub(",", ".", x) %>% gsub(".%$", "", .) %>% as.numeric()/100
47		}
48
49
50		# Création du dataset utile pour la production du tableau
51	1x	tab <- data %>%
52		# Filtre sur l'année N
53	1x	dplyr::filter(.data$millesime == annee) %>%
54		# Modification de l'ordre des levels de la variable TypeZone
55	1x	dplyr::mutate(taux_ls_age_0_5 = mef(.data$nb_ls_age_0_5, .data$nb_ls_actif),
56	1x	taux_ls_age_5_10 = mef(.data$nb_ls_age_5_10, .data$nb_ls_actif),
57	1x	taux_ls_age_10_20 = mef(.data$nb_ls_age_10_20, .data$nb_ls_actif),
58	1x	taux_ls_age_20_40 = mef(.data$nb_ls_age_20_40, .data$nb_ls_actif),
59	1x	taux_ls_age_40_60 = mef(.data$nb_ls_age_40_60, .data$nb_ls_actif),
60	1x	taux_ls_age_60_plus = mef(.data$nb_ls_age_60_plus, .data$nb_ls_actif)) %>%
61	1x	dplyr::select(dplyr::ends_with("Zone"), "taux_ls_age_0_5", "taux_ls_age_5_10", "taux_ls_age_10_20",
62	1x	"taux_ls_age_20_40", "taux_ls_age_40_60", "taux_ls_age_60_plus") %>%
63		# Tri de la table pour faire apparaitre dans l'ordre FM/Région/Département/EPCI
64	1x	propre.rpls::arrange_zonage()
65
66	1x	if(!epci){
67	1x	tab <- dplyr::filter(tab, .data$TypeZone != "Epci")
68		}
69
70		# Création du tableau
71	1x	tableau <- tab %>%
72		# Sélection des variables utiles
73	1x	dplyr::select(-"TypeZone", -"CodeZone") %>%
74		# Mise en place des titres de colonnes
75	1x	kableExtra::kable("html", col.names=c("Zone",
76	1x	"Logements \u00e2g\u00e9s\nde moins\u00a0de\u00a05\u00a0ans",
77	1x	"Logements \u00e2g\u00e9s\nde 5\u00a0\u00e0\u00a09\u00a0ans",
78	1x	"Logements \u00e2g\u00e9s\nde 10\u00a0\u00e0\u00a019\u00a0ans",
79	1x	"Logements \u00e2g\u00e9s\nde 20\u00a0\u00e0\u00a039\u00a0ans",
80	1x	"Logements \u00e2g\u00e9s\nde 40\u00a0\u00e0\u00a059\u00a0ans",
81	1x	"Logements \u00e2g\u00e9s\nde plus\u00a0de\u00a060\u00a0ans"),
82	1x	format.args = list(big.mark = " "),
83	1x	align = "lrrrrrr",
84	1x	caption = glue::glue(titre)) %>%
85		# Formatage de la taille des caractères
86	1x	kableExtra::kable_styling(font_size = 12) %>%
87		# Formatage de la ligne "R\u00e9gion" : fond blanc, gras
88	1x	kableExtra::row_spec(which(dplyr::pull(tab, "TypeZone") == "R\u00e9gions"), bold = TRUE, background = "#FFFFFF") %>%
89		# Formatage des lignes "D\u00e9partements" : fond gris clair, gras
90	1x	kableExtra::row_spec(which(dplyr::pull(tab, "TypeZone") == "D\u00e9partements"), bold = TRUE, background = "#E5E5E5") %>%
91		# Formatage des lignes "Epci" et "EPT" : fond blanc, taille 10
92	1x	kableExtra::row_spec(which(dplyr::pull(tab, "TypeZone") %in% c("EPT", "Epci")), bold = FALSE, background = "#FFFFFF",
93	1x	font_size = 10) %>%
94		# Ajout d'une indentation pour les lignes "Epci" et "EPT"
95	1x	kableExtra::add_indent(which(dplyr::pull(tab, "TypeZone") %in% c("EPT", "Epci"))) %>%
96		# Formatage des lignes "France" : fond gris foncé, gras
97	1x	kableExtra::row_spec(which(dplyr::pull(tab, "TypeZone") == "France"), bold = TRUE, background = "#C4C4C4") %>%
98		# Création note de bas de page avec la source et l ajout parametrable d une note de lecture
99	1x	kableExtra::footnote(general = paste0(dplyr::if_else(note_de_lecture != "",
100	1x	paste0(note_de_lecture, "\n"),
101		""),
102	1x	caption(sources = 1, mil_rpls = annee)), general_title = "")
103
104		# insere une scrollbox pour une meilleure lisibilite
105	1x	if (add_scroll) {
106	!	tableau <- tableau %>%
107	!	kableExtra::scroll_box(width = "100%", height = "500px", fixed_thead = TRUE)
108		}
109
110		# metadonnees a faire figurer dans la table des matiere de l'export xls
111	1x	index <- data.frame(onglet = "tableau_4_1", titre = glue::glue(titre) %>% gsub("<br>", " ", .))
112
113		# donnees a faire figurer de l'export xls (typage numerique)
114	1x	tab2 <- tab %>%
115	1x	dplyr::mutate(dplyr::across(dplyr::starts_with("taux_ls_age_"), deformat))
116
117
118	1x	return(list(viz = tableau, tab_xls = tab2, meta = index))
119
120
121
122		}

1		#' Chapitre 4: Verbatim
2		#'
3		#' @description Production des commentaires verbatim du chapitre 4.
4
5		#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref
6		#' @param annee Le millesime renseigné par l'utilisateur (au format numérique)
7		#'
8		#' @return Un vecteur de 3 chaînes de caractères comprenant le titre, l'intertitre et les commentaires essentiels du chapitre 4
9		#'
10		#' @importFrom dplyr filter pull mutate
11		#' @importFrom glue glue
12		#' @importFrom propre.datareg datareg
13		#' @importFrom rlang .data
14		#'
15		#' @export
16		#'
17		#' @examples
18		#' indic_rpls_ref <- propre.rpls::lire_rpls_exemple() %>%
19		#' dplyr::filter(Zone_ref)
20		#'
21		#' creer_verbatim_4(data = indic_rpls_ref, annee = 2019)[["titre"]]
22		#' creer_verbatim_4(data = indic_rpls_ref, annee = 2019)[["intertitre"]]
23		#' creer_verbatim_4(data = indic_rpls_ref, annee = 2019)[["commentaires"]]
24
25
26		creer_verbatim_4 <- function(data, annee) {
27
28		# on récupère les formulations idiomatiques grâce à {propre.datareg}
29	4x	code_region <- dplyr::filter(data, grepl("gions", .data$TypeZone)) %>%
30	4x	dplyr::pull("CodeZone") %>% unique %>% as.character
31
32	4x	verb_reg <- propre.datareg::datareg(code_reg = code_region)
33
34	4x	drom <- ifelse(code_region %in% paste0("0", 1:6), TRUE, FALSE)
35
36	4x	prepdata <- data %>%
37	4x	dplyr::filter(.data$millesime == annee) %>%
38	4x	dplyr::mutate(nb_dpe_connus = .data$nb_ls_dpe_ener_A + .data$nb_ls_dpe_ener_B + .data$nb_ls_dpe_ener_C + .data$nb_ls_dpe_ener_D + .data$nb_ls_dpe_ener_E + .data$nb_ls_dpe_ener_F + .data$nb_ls_dpe_ener_G,
39	4x	part_ls_dpe_ener_a_b = (.data$nb_ls_dpe_ener_A + .data$nb_ls_dpe_ener_B) / .data$nb_dpe_connus * 100,
40	4x	part_ls_dpe_ener_f_g = (.data$nb_ls_dpe_ener_F + .data$nb_ls_dpe_ener_G) / .data$nb_dpe_connus * 100,
41	4x	anciennete_moyenne = .data$age_moyen)
42
43	4x	part_dpe_renseigne_reg <- prepdata %>%
44	4x	dplyr::filter(.data$TypeZone == "R\u00e9gions") %>%
45	4x	dplyr::pull("part_dpe_realise") %>%
46	4x	format_fr_pct()
47
48	4x	part_a_b_reg <- prepdata %>%
49	4x	dplyr::filter(.data$TypeZone == "R\u00e9gions") %>%
50	4x	dplyr::pull("part_ls_dpe_ener_a_b") %>%
51	4x	format_fr_pct()
52
53	4x	part_f_g_reg <- prepdata %>%
54	4x	dplyr::filter(.data$TypeZone == "R\u00e9gions") %>%
55	4x	dplyr::pull("part_ls_dpe_ener_f_g") %>%
56	4x	format_fr_pct()
57
58		# on a besoin de l'âge avec des décimales pour comparer l'ancienneté des parcs (régional et national)
59	4x	anciennete_moyenne_reg_brut <- prepdata %>%
60	4x	dplyr::filter(.data$TypeZone == "R\u00e9gions") %>%
61	4x	dplyr::pull("anciennete_moyenne")
62	4x	anciennete_moyenne_reg <- anciennete_moyenne_reg_brut %>%
63	4x	format_fr_nb()
64
65	4x	anciennete_moyenne_f_brut <- prepdata %>%
66	4x	dplyr::filter(grepl("FRMETRO", .data$CodeZone)) %>%
67	4x	dplyr::pull("anciennete_moyenne")
68	4x	anciennete_moyenne_f <- anciennete_moyenne_f_brut %>%
69	4x	format_fr_nb()
70
71	4x	if(drom) {
72	!	libelle_f <- "sur l\'ensemble de la France"
73		} else {
74	4x	part_dpe_renseigne_f <- prepdata %>%
75	4x	dplyr::filter(.data$TypeZone == "FRMETRO") %>%
76	4x	dplyr::pull("part_dpe_realise") %>%
77	4x	format_fr_pct()
78	4x	part_a_b_f <- prepdata %>%
79	4x	dplyr::filter(.data$CodeZone == "FRMETRO") %>%
80	4x	dplyr::pull("part_ls_dpe_ener_a_b") %>%
81	4x	format_fr_pct()
82	4x	part_f_g_f <- prepdata %>%
83	4x	dplyr::filter(.data$CodeZone == "FRMETRO") %>%
84	4x	dplyr::pull("part_ls_dpe_ener_f_g") %>%
85	4x	format_fr_pct()
86	4x	libelle_f <- "en France m\u00e9tropolitaine"
87		}
88
89
90	4x	titre_ch4 <- ifelse(drom, "L\'anciennet\u00e9 du parc social", "L\'anciennet\u00e9 et l\'\u00e9tat \u00e9nerg\u00e9tique du parc social")
91
92
93	4x	if(anciennete_moyenne_reg_brut - anciennete_moyenne_f_brut < -1.5) {
94	4x	qualificatif_anciennete <- "plus r\u00e9cent qu\'"
95	!	} else if(anciennete_moyenne_reg_brut - anciennete_moyenne_f_brut > 1.5) {
96	!	qualificatif_anciennete <- "plus ancien qu\'"
97		} else {
98	!	qualificatif_anciennete <- "comparable "
99		}
100
101	4x	verbatim_chap_4 <- list(titre = titre_ch4, intertitre ="", commentaires ="")
102
103
104	4x	verbatim_chap_4$intertitre <- glue::glue("Un parc social {qualificatif_anciennete}au niveau national")
105
106	4x	commentaires <- glue::glue(
107	4x	"Au 1er janvier {annee}, l\u2019anciennet\u00e9 moyenne du parc de logements sociaux {verb_reg$de_la_region_nom_region} ",
108	4x	"est de {anciennete_moyenne_reg} ans, ")
109
110	4x	if(anciennete_moyenne_reg != anciennete_moyenne_f){
111	4x	verbatim_chap_4$commentaires <- glue::glue(commentaires, "contre {anciennete_moyenne_f} ans {libelle_f}. ")
112		} else {
113	!	verbatim_chap_4$commentaires <- glue::glue(commentaires, "comme {libelle_f}. ")
114		}
115
116
117	4x	if (!drom) {
118	4x	commentaires_metro <- glue::glue("L\u2019anciennet\u00e9 des constructions influe sur le diagnostic de performance \u00e9nerg\u00e9tique
119	4x	des logements (DPE). A la fin de l\u2019ann\u00e9e {annee -1}, {part_dpe_renseigne_reg} des logements du parc locatif social de la r\u00e9gion ont fait l\u2019objet
120	4x	d\u2019un DPE (r\u00e9alis\u00e9 selon les r\u00e8gles en vigueur avant le 1er juillet 2021).
121	4x	Les logements class\u00e9s en A et B, consid\u00e9r\u00e9s comme peu \u00e9nergivores, repr\u00e9sentent {part_a_b_reg} du parc social disposant d\u2019un DPE renseign\u00e9, contre {part_a_b_f} en France m\u00e9tropolitaine. Les logements class\u00e9s en F et G, qualifi\u00e9s de \u00ab\u00a0passoires thermiques\u00a0\u00bb
122	4x	et consid\u00e9r\u00e9s comme tr\u00e8s \u00e9nergivores, en repr\u00e9sentent {part_f_g_reg} ({part_f_g_f} au niveau national).")
123
124	4x	verbatim_chap_4$commentaires <- glue::glue(verbatim_chap_4$commentaires, commentaires_metro)
125		}
126
127	4x	verbatim_chap_4
128		}
129

1		#' Creation de la carte represantant les loyers moyens au m2 par EPCI (chap Loyers et financements).
2		#'
3		#' @description Creation de la carte des loyers moyens/m² par EPCI.
4		#'
5		#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur.
6		#' @param annee Une annee, parmi les millesimes selectionnables par l'utilisateur, au format numérique.
7		#' @param carto La table des fonds de carte realisee avec \code{mapfactory::\link{fond_carto}}.
8		#' @param bornes Les bornes manuelles.
9		#' @param palette Choix de la palette de couleurs parmi celle de \code{gouvdown::\link{scale_color_gouv_discrete}}
10		#' @param inverse Choix du sens de la progression des couleurs : du plus sombre au plus clair (FALSE) ou du plus clair au plus sombre (TRUE)
11		#' @param maille Le maillage souhaite pour la carte, a choisir parmi "commune", "EPCI" ou "département". "EPCI" par defaut.
12		#' @param titre Une chaine de caractère si vous voulez ajouter un titre specifique. (par défaut: "Loyer moyen par {maille} au 1er janvier {annee}")
13		#' @param note_de_lecture Une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
14		#' @param na_label L'etiquette à afficher dans la legende pour les valeurs manquantes ("Valeurs manquantes" par défaut).
15		#' @param ... Autres paramètres de la fonction [\code{mapfactory::creer_carte}](https://dreal-pdl.gitlab-pages.din.developpement-durable.gouv.fr/csd/mapfactory/reference/creer_carte.html)
16		#'
17		#' @return Une liste de 3 objets : Une carte choroplethe mise en page au format html (viz),
18		#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
19		#'
20		#' @importFrom dplyr filter slice pull if_else select
21		#' @importFrom glue glue
22		#' @importFrom mapfactory creer_carte
23		#' @importFrom COGiter list_epci_in_reg list_com_in_reg
24		#' @export
25		#'
26		#' @examples
27		#' indicateurs_rpls <- lire_rpls_exemple()
28		#'
29		#' creer_carte_6_1(data = indicateurs_rpls,
30		#' annee = 2019,
31		#' carto = mapfactory::fond_carto("Corse"),
32		#' bornes = NULL,
33		#' note_de_lecture = ""
34		#' )[["viz"]]
35
36		creer_carte_6_1 <- function(data, annee, carto, bornes = NULL, palette = "pal_gouv_i", inverse = TRUE, maille = "EPCI",
37		titre = "Loyer moyen par {maille} \nau 1er janvier {annee}", note_de_lecture = "",
38		na_label = "Valeurs manquantes", ...) {
39
40		# récupérer le code de la région à partir du jeu de données
41	1x	reg <- data %>%
42	1x	dplyr::filter(.data$TypeZone == "R\u00e9gions", .data$Zone_ref == TRUE) %>%
43	1x	dplyr::slice(1) %>%
44	1x	dplyr::pull("CodeZone") %>%
45	1x	as.character()
46
47		# preparer la table à visualiser
48	1x	data <- data %>%
49	1x	dplyr::filter(.data$millesime == annee)
50
51	1x	map <- mapfactory::creer_carte(data = data, code_region = reg, carto = carto, maillage = maille, indicateur = loyer_m2,
52	1x	type_viz = "choroplethe", palette = palette, inverse = inverse, interactive = TRUE,
53	1x	titre = glue::glue(titre), sous_titre = "en \u20AC/m\u00B2 de surface habitable",
54	1x	bas_de_page = dplyr::if_else(note_de_lecture != "" ,
55	1x	paste0(note_de_lecture, "\n\n", caption(sources = 1, mil_rpls = annee)),
56	1x	caption(sources = 1, mil_rpls = annee)),
57	1x	evolution = FALSE, suffixe = " \u20AC/m\u00B2", na_label = na_label, bornes = bornes, ...)
58
59
60		# donnees a faire figurer dans l'export xls
61	1x	codes_zones_a_garder <- c(COGiter::list_epci_in_reg(reg), COGiter::list_com_in_reg(reg))
62	1x	data_xls <- data %>%
63		# filtre sur la region et la maille de la carte, attention les noms de mailles dans TypeZone sont légèrement différents du paramètre maille
64	1x	dplyr::filter(grepl(tolower(maille), tolower(.data$TypeZone)), .data$CodeZone %in% codes_zones_a_garder) %>%
65	1x	dplyr::select("CodeZone", "Zone", "loyer_m2")
66
67		# metadonnees a faire figurer dans la table des matiere de l'export xls
68	1x	index <- data.frame(onglet = "carte_6_1", titre = glue::glue(titre) %>% gsub("\n", "", .))
69
70	1x	return(list(viz = map, tab_xls = data_xls, meta = index))
71
72		}

1		#' Chapitre 1: Verbatim
2		#'
3		#' @description Production des commentaires verbatim du chapitre 1.
4
5		#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref
6		#' @param annee Le millesime renseigné par l'utilisateur (au format numérique)
7		#'
8		#' @return Une chaîne de caractères comprenant les commentaires essentiels du chapitre 1
9		#'
10		#' @importFrom dplyr filter mutate select transmute case_when pull
11		#' @importFrom tidyr pivot_wider
12		#' @importFrom glue glue
13		#' @importFrom propre.datareg datareg
14		#' @importFrom rlang .data
15		#'
16		#' @export
17		#'
18		#' @examples
19		#' indic_rpls_ref <- propre.rpls::lire_rpls_exemple() %>%
20		#' dplyr::filter(Zone_ref)
21		#'
22		#' creer_verbatim_1(data = indic_rpls_ref, annee = 2020)
23		#'
24
25		creer_verbatim_1 <- function(data, annee) {
26
27		# on calcule d'abord les indicateurs nécessaires aux commentaires
28	1x	evol_n_nmoins_1 <- data %>%
29		# on garde les lignes pertinentes, Fce metro si reg metropolitaine (CodeZone == FRMETRO) ou Fce entiere si DROM (CodeZone == FRMETRODROM)
30	1x	dplyr::filter(.data$millesime == annee, grepl("gions", .data$TypeZone) \| grepl("FRMETRO", .data$CodeZone)) %>%
31		# on normalise le lib des millesimes
32	1x	dplyr::select("millesime", "TypeZone", "evolution_n_nmoins1") %>%
33	1x	dplyr::transmute(TypeZone = substr(.data$TypeZone, 1, 1), # on simplifie le lib de niv geo pour limiter les soucis d'encodage
34	1x	evolution_n_nmoins1 = round(evolution_n_nmoins1, 1)) %>%
35	1x	tidyr::pivot_wider(names_from = "TypeZone", values_from = "evolution_n_nmoins1", names_prefix = ".") %>%
36	1x	dplyr::mutate(qual_evol_reg = dplyr::case_when(
37	1x	(.data$.R - .data$.F) > 0.5 ~ "plus importante",
38	1x	(.data$.R - .data$.F) > 0.1 ~ "l\u00e9g\u00e8rement plus importante",
39	1x	(.data$.R - .data$.F) > -0.1 ~ "\u00e9quivalente",
40	1x	(.data$.R - .data$.F) > -0.5 ~ "un peu moindre",
41	1x	(.data$.R - .data$.F) <= -0.5 ~ "moindre")
42		)
43
44	1x	evol_pluriannuelles <- data %>%
45		# on garde la ligne pertinente
46	1x	dplyr::filter(.data$millesime == annee, grepl("gions", .data$TypeZone)) %>%
47		# on normalise le lib des millesimes
48	1x	dplyr::select("millesime", "TypeZone", "evolution_annees_rp", "evolution_rp") %>%
49	1x	dplyr::transmute(TypeZone = substr(.data$TypeZone, 1, 1),# on simplifie le lib de niv geo pour limiter les soucis d'encodage
50	1x	evolution_annees_rp = round(.data$evolution_annees_rp, 1),
51	1x	evolution_rp = round(.data$evolution_rp, 1)) %>%
52	1x	dplyr::mutate(qual_evol_reg_vs_rp = dplyr::case_when(
53	1x	(.data$evolution_annees_rp - .data$evolution_rp) > 0 ~ "davantage que l\'ensemble des",
54	1x	(.data$evolution_annees_rp - .data$evolution_rp) < 0 ~ "moins que l\'ensemble des",
55	1x	(.data$evolution_annees_rp - .data$evolution_rp) == 0 ~ "de mani\u00e8re comparable aux")
56		)
57
58	1x	densite <- data %>%
59	1x	dplyr::filter(.data$millesime == annee, grepl("gions", .data$TypeZone) \| grepl("FRMETRO", .data$CodeZone)) %>%
60	1x	dplyr::transmute(TypeZone = substr(.data$TypeZone, 1, 1),
61	1x	densite_pr_100RP = (100 * .data$nb_ls_actif / .data$nb_rp) %>% round(1))
62
63		# les formulations idiomatiques grâce à {propre.datareg}
64	1x	id_reg <- dplyr::filter(data, grepl("gions", .data$TypeZone)) %>%
65	1x	dplyr::pull("CodeZone") %>% unique %>% as.character
66	1x	verb_reg <- propre.datareg::datareg(code_reg = id_reg)
67
68		# on crée ensuite une liste nommee des differents parametres
69	1x	verb1 <- list(nom_reg = verb_reg$dans_la_region_nom_region,
70	1x	nb_ls_reg = dplyr::filter(data, grepl("gions", .data$TypeZone), millesime == annee) %>%
71	1x	dplyr::pull("nb_ls_actif") %>% format_fr_nb(dec = 0, big_mark = " "),
72	1x	mil = annee,
73	1x	evol_n_nmoins1_reg = evol_n_nmoins_1$.R %>% format_fr_pct,
74	1x	evol_n_nmoins1_nat = evol_n_nmoins_1$.F %>% format_fr_pct,
75	1x	evol_pluriann_reg = evol_pluriannuelles$evolution_annees_rp %>% format_fr_pct,
76	1x	nb_an_evol_rp = lgt_rp$nb_an_evol_rp[1],
77	1x	evolution_rp = evol_pluriannuelles$evolution_rp %>% format_fr_pct,
78	1x	adj_evol_reg_vs_rp = evol_pluriannuelles$qual_evol_reg_vs_rp,
79	1x	adj_evol_reg = evol_n_nmoins_1$qual_evol_reg,
80	1x	densite_reg = dplyr::filter(densite, .data$TypeZone == "R") %>%
81	1x	dplyr::pull("densite_pr_100RP") %>% format_fr_pct,
82	1x	densite_metro_ou_nat = dplyr::filter(densite, .data$TypeZone == "F") %>%
83	1x	dplyr::pull("densite_pr_100RP") %>% format_fr_pct
84		)
85
86		# production du verbatim a partir des elements precedents
87
88		## la premiere phrase est commune a tous
89	1x	phrase1 <- glue::glue("L\'offre locative sociale {verb1$nom_reg} s\'\u00e9l\u00e8ve \u00e0 {verb1$nb_ls_reg} logements au 1er janvier {verb1$mil}. ")
90
91		# pour la 2e phrase, on separe les cas ou le parc regional recule ou stagne des cas où le parc regional progresse
92	1x	if(verb1$evol_n_nmoins1_reg > 0) {
93	1x	phrase2 <- glue::glue("Sur un an, elle augmente de {verb1$evol_n_nmoins1_reg}, soit une progression {verb1$adj_evol_reg} qu\'au niveau national ({verb1$evol_n_nmoins1_nat}). ")
94	!	} else if(verb1$evol_n_nmoins1_reg < 0) {
95	!	verb1$evol_n_nmoins1_reg <- verb1$evol_n_nmoins1_reg %>% gsub("-", "", .)
96	!	phrase2 <- glue::glue("Sur un an, elle diminue de {verb1$evol_n_nmoins1_reg}, alors qu\'elle progresse de {verb1$evol_n_nmoins1_nat} au niveau national. ")
97		} else {
98	!	phrase2 <- glue::glue("Sur un an, elle reste stable, alors qu\'elle progresse de {verb1$evol_n_nmoins1_nat} au niveau national. ")
99		}
100
101		# pour la 3e phrase, on separe les cas selon si le parc de ls augmente plus/moins que le parc de rp
102
103	1x	phrase3 <- glue::glue("Les logements sociaux ont progress\u00e9 de {verb1$evol_pluriann_reg} en {verb1$nb_an_evol_rp} ans, {verb1$adj_evol_reg_vs_rp} r\u00e9sidences principales sur la p\u00e9riode {lgt_rp$mil_RP_old[1]}-{lgt_rp$mil_RP[1]} ")
104	1x	if(verb1$evol_pluriann_reg != verb1$evolution_rp) {
105	1x	phrase3 <- glue::glue("{phrase3} ({verb1$evolution_rp}). ")
106		} else {
107	!	phrase3 <- glue::glue("{phrase3}. }")
108		}
109
110		## pour la 4e phrase, on separe selon que les rp representent la meme part dans la region qu'au niveau national ou non
111
112	1x	if(verb1$densite_reg != verb1$densite_metro_ou_nat) {
113	1x	phrase4 <- glue::glue("Ainsi, le parc social repr\u00e9sente, au 1er janvier {verb1$mil}, {verb1$densite_reg} des r\u00e9sidences principales contre {verb1$densite_metro_ou_nat} au niveau national. ")
114		} else {
115	!	phrase4 <- glue::glue("Ainsi, le parc social repr\u00e9sente, au 1er janvier {verb1$mil}, {verb1$densite_reg} des r\u00e9sidences principales, comme au niveau national. ")
116		}
117
118
119
120	1x	verbatim_chap_1 <- glue::glue("{phrase1}{phrase2}\n\n{phrase3}\n\n{phrase4}")
121
122	1x	verbatim_chap_1
123		}
124
125
126

1		#' Chapitre 6: Verbatim
2		#'
3		#' @description Production des commentaires et de l'intertitre verbatim du chapitre 6.
4
5		#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur
6		#' @param annee Le millesime renseigné par l'utilisateur (au format numérique)
7		#'
8		#' @return Un vecteur de 2 chaînes de caractères comprenant l'intertitre et les commentaires essentiels du chapitre 6
9		#'
10		#' @importFrom dplyr filter select transmute pull contains mutate case_when starts_with across everything
11		#' @importFrom glue glue
12		#' @importFrom propre.datareg datareg
13		#' @importFrom rlang .data
14		#' @importFrom tidyr pivot_wider
15		#'
16		#' @export
17		#'
18		#' @examples
19		#' indic_rpls <- propre.rpls::lire_rpls_exemple()
20		#'
21		#' creer_verbatim_6(data = indic_rpls, annee = 2019)[["intertitre"]]
22		#' creer_verbatim_6(data = indic_rpls, annee = 2019)[["commentaires"]]
23
24
25		creer_verbatim_6 <- function(data, annee) {
26
27		# on calcule d'abord les indicateurs necessaires aux commentaires
28	3x	mises_svc <- data %>%
29		# on garde les lignes pertinentes : Fce metro si reg metropolitaine (CodeZone == FRMETRO) ou Fce entiere si DROM (CodeZone == FRMETRODROM)
30	3x	dplyr::filter(.data$millesime == annee, grepl("gion", .data$TypeZone) \| grepl("FRMETRO", .data$CodeZone), .data$Zone_ref) %>%
31	3x	dplyr::select("millesime", "TypeZone", "nb_plai", "nb_mes", "nb_plus") %>%
32	3x	dplyr::transmute(TypeZone = substr(.data$TypeZone, 1, 1), # on simplifie le lib de niv geo pour limiter les soucis d'encodage
33	3x	part_plai = round(.data$nb_plai / .data$nb_mes * 100, 1),
34	3x	part_plus = round(.data$nb_plus / .data$nb_mes * 100, 1)) %>%
35	3x	tidyr::pivot_wider(names_from = "TypeZone", values_from = c("part_plai", "part_plus"))
36
37		# une variable pour recuperer l'identifiant de la région choisie
38	3x	id_reg <- dplyr::filter(data, .data$Zone_ref, grepl("gion", .data$TypeZone)) %>%
39	3x	dplyr::pull("CodeZone") %>% unique() %>% as.character
40
41		# un booleen pour determiner si la region choisie est metropolitaine ou non
42	3x	metro <- !(id_reg %in% paste0("0", 1:6))
43
44	3x	loyers_0 <- data %>%
45	3x	dplyr::filter(.data$millesime == annee, grepl("gions", .data$TypeZone) \| grepl("FRMETRO", .data$CodeZone)) %>%
46	3x	dplyr::select(dplyr::contains("Zone"), "somme_loyer", "somme_surface", "somme_loyer_recent", "somme_surface_recent",
47	3x	"somme_loyer_nb_plai", "somme_surface_nb_plai", "somme_loyer_nb_pls", "somme_surface_nb_pls") %>%
48	3x	dplyr::mutate(TypeZone = substr(.data$TypeZone, 1, 1),
49	3x	reg_comp = dplyr::case_when(
50	3x	.data$TypeZone != "R" ~ FALSE,
51	3x	.data$TypeZone == "R" & metro & .data$CodeZone %in% paste0("0", 1:6) ~ FALSE,
52	3x	.data$TypeZone == "R" & metro & !(.data$CodeZone %in% paste0("0", 1:6)) ~ TRUE,
53	3x	.data$TypeZone == "R" & !metro & .data$CodeZone %in% paste0("0", 1:6) ~ TRUE,
54	3x	.data$TypeZone == "R" & !metro & !(.data$CodeZone %in% paste0("0", 1:6)) ~ FALSE,
55	3x	TRUE ~ FALSE),
56	3x	loyer_moy = .data$somme_loyer / .data$somme_surface ,
57	3x	loyer_moy_recent = .data$somme_loyer_recent / .data$somme_surface_recent ,
58	3x	loyer_moy_plai = .data$somme_loyer_nb_plai / .data$somme_surface_nb_plai ,
59	3x	loyer_moy_pls = .data$somme_loyer_nb_pls / .data$somme_surface_nb_pls) %>%
60	3x	dplyr::select(-dplyr::starts_with("somme_"))
61
62		# calcul du rang du loyer version numérqiue (rang_num) et caractère selon l'ordre croissant ou decroissant (rang_loy rang_loy_desc)
63	3x	loyers_rang <- loyers_0 %>%
64	3x	dplyr::filter(.data$reg_comp) %>%
65	3x	dplyr::select("Zone_ref", "loyer_moy") %>%
66	3x	dplyr::mutate(rang_num = rank(-.data$loyer_moy),
67	3x	rang_loy = dplyr::case_when(
68	3x	.data$rang_num == 1 ~ "",
69	3x	TRUE ~ paste0(.data$rang_num, "e ")),
70	3x	rang_num_desc = rank(.data$loyer_moy),
71	3x	rang_loy_desc = dplyr::case_when(
72	3x	.data$rang_num_desc == 1 ~ "",
73	3x	TRUE ~ paste0(.data$rang_num_desc, "e "))) %>%
74	3x	dplyr::filter(.data$Zone_ref) %>%
75	3x	dplyr::select("rang_num", "rang_loy", "rang_loy_desc")
76
77	3x	loyers <- loyers_0 %>%
78	3x	dplyr::filter(.data$Zone_ref) %>%
79	3x	dplyr::select("TypeZone", dplyr::starts_with("loyer_moy")) %>%
80	3x	tidyr::pivot_wider(names_from = "TypeZone", values_from = dplyr::starts_with("loyer_moy")) %>%
81	3x	dplyr::mutate(dplyr::across(dplyr::everything(), format_fr_nb))
82
83
84		# on récupère les formulations idiomatiques grâce à {propre.datareg}
85	3x	verb_reg <- propre.datareg::datareg(code_reg = id_reg)
86
87
88		# on cree ensuite une liste nommee des differents parametres
89	3x	verb6 <- list(part_mes_plai_r = mises_svc$part_plai_R[1] %>% format_fr_pct,
90	3x	part_mes_plus_r = mises_svc$part_plus_R[1] %>% format_fr_pct,
91	3x	annee_prec = annee - 1,
92	3x	dans_la_region = verb_reg$dans_la_region,
93	3x	part_mes_plai_fr = mises_svc$part_plai_F[1] %>% format_fr_pct,
94	3x	comp_fr_mes_plai = ifelse(metro, "France m\u00e9tropolitaine", "France enti\u00e8re"),
95	3x	loyer_moy_r = loyers$loyer_moy_R,
96	3x	loyer_moy_fr = loyers$loyer_moy_F,
97	3x	reg_dep = verb_reg$la_region,
98	3x	reg_rang = dplyr::case_when(
99	3x	metro & loyers_rang$rang_num <= 7 ~ paste0("la ", loyers_rang$rang_loy,"r\u00e9gion la plus ch\u00e8re de m\u00e9tropole"),
100	3x	metro & loyers_rang$rang_num > 7 ~ paste0("la ", loyers_rang$rang_loy_desc,"r\u00e9gion la moins ch\u00e8re de m\u00e9tropole"),
101	3x	!metro & loyers_rang$rang_num <=3 ~ paste0("le ", loyers_rang$rang_loy,"d\u00e9partement le plus cher d\u2019outre-mer"),
102	3x	TRUE ~ paste0("le ", loyers_rang$rang_loy_desc,"d\u00e9partement le moins cher d\u2019outre-mer")),
103	3x	loy_moy_recent_r = loyers$loyer_moy_recent_R,
104	3x	comp_fr_loyer = ifelse(metro, "En France m\u00e9tropolitaine", "Sur l\'ensemble de la France"),
105	3x	loy_moy_recent_fr = loyers$loyer_moy_recent_F,
106	3x	comp_fr_loy_recent = ifelse(metro, "en France m\u00e9tropolitaine", "sur l\'ensemble de la France"),
107	3x	loyer_moy_plai_r = loyers$loyer_moy_plai_R,
108	3x	loyer_moy_pls_r = loyers$loyer_moy_pls_R,
109	3x	nom_plus_long = ifelse(metro, "PLUS (Pr\u00eat locatif \u00e0 usage social)",
110	3x	"LLS (Logement locatif social)"),
111	3x	nom_plai_long = ifelse(metro, "PLAI (pr\u00eat locatif aid\u00e9 d\u2019int\u00e9gration)",
112	3x	"LLTS (Logement locatif tr\u00e8s social)"),
113	3x	nom_plus_court = ifelse(metro, "PLUS", "LLS"),
114	3x	nom_plai_court = ifelse(metro, "PLAI", "LLTS")
115		)
116
117
118		# production du verbatim a partir des elements precedents
119	3x	verbatim_chap_6 <- list(intertitre ="", commentaires ="")
120	3x	verbatim_chap_6$intertitre <- glue::glue("{verb6$part_mes_plai_r} des mises en service \u00e0 destination des plus pr\u00e9caires")
121
122		# paragraphe 1
123	3x	parag1 <- glue::glue("Le {verb6$nom_plus_long} finance {verb6$part_mes_plus_r} des logements mis en service en {verb6$annee_prec} {verb6$dans_la_region}.
124	3x	Le {verb6$nom_plai_long} finance des logements \u00e0 destination des publics les plus en difficult\u00e9s. Il a concern\u00e9
125	3x	{verb6$part_mes_plai_r} des mises en service en {verb6$annee_prec} {verb6$dans_la_region} " )
126	3x	if(verb6$part_mes_plai_r != verb6$part_mes_plai_fr){
127	3x	parag1 <- glue::glue(parag1, "contre {verb6$part_mes_plai_fr} en {verb6$comp_fr_mes_plai}.")
128		} else {
129	!	parag1 <- glue::glue(parag1, "comme {verb6$comp_fr_loy_recent}.")
130		}
131
132		# paragraphe 2
133	3x	parag2 <- glue::glue(
134	3x	"Le loyer moyen s\u2019\u00e9l\u00e8ve \u00e0 {verb6$loyer_moy_r}\u202f\u20ac/m\u00b2 en {annee}, ce qui en fait {verb6$reg_rang}.
135	3x	{verb6$comp_fr_loyer}, le loyer moyen s\u2019affiche \u00e0 {verb6$loyer_moy_fr}\u202f\u20ac/m\u00b2."
136		)
137
138		# paragraphe 3
139	3x	parag3 <- "Dans le parc r\u00e9cent (mis en service depuis 5 ans ou moins), le loyer moyen s\u2019\u00e9tablit \u00e0
140	3x	{verb6$loy_moy_recent_r}\u202f\u20ac/m\u00b2 "
141	3x	if (verb6$loy_moy_recent_r != verb6$loy_moy_recent_fr){
142	3x	parag3 <- glue::glue(parag3, "contre {verb6$loy_moy_recent_fr}\u202f\u20ac/m\u00b2 {verb6$comp_fr_loy_recent}.")
143		} else {
144	!	parag3 <- glue::glue(parag3, "comme {verb6$comp_fr_loy_recent}.")
145		}
146
147		# paragraphe 4
148	3x	parag4 <- glue::glue(
149	3x	"Le loyer moyen est par ailleurs conditionn\u00e9 par le mode de financement initial.
150	3x	Il s\u2019affiche \u00e0 {verb6$loyer_moy_plai_r}\u202f\u20ac/m\u00b2 pour
151	3x	les logements financ\u00e9s par un {verb6$nom_plai_court} et {verb6$loyer_moy_pls_r}\u202f\u20ac/m\u00b2 pour ceux financ\u00e9s par un PLS."
152		)
153
154
155	3x	verbatim_chap_6$commentaires <- glue::glue("{parag1}\n\n{parag2}\n\n{parag3}\n\n{parag4}")
156
157	3x	verbatim_chap_6
158		}

1		#' Phase de datapreparation pour la publication
2		#'
3		#' @description Consolidation des indicateurs aux differentes échelles et creation d'un champ de filtrage des territoires pour les illustrations.
4		#'
5		#' @param nom_reg Le nom de la region au format texte.
6		#' @param choix_epci Le parametre utilisateur de détail par epci au format texte : "1- Tous les EPCI de la zone" ou "2- Liste d EPCI à saisir".
7		#' @param epci_list Le vecteur des codes epci de reference, defini dans les parametres.
8		#' @param test TRUE si on souhaite tester dataprep() sur 100 communes choisies au hasard.
9		#'
10		#' @return Un dataframe d'indicateurs : une ligne par entite geographique et millesime, le champ Zone_ref permet de filtrer les territoires pour ne conserver que ceux a inclure dans les illustrations.
11		#' @importFrom COGiter cogifier ajouter_zonage
12		#' @importFrom dplyr select full_join mutate vars starts_with mutate filter case_when across pull group_by ungroup lag arrange
13		#' @importFrom forcats fct_relevel
14		#' @importFrom rlang .data
15		#' @importFrom tidyr replace_na expand_grid
16		#' @export
17		#'
18		#' @examples
19		#' \dontrun{
20		#' indicateurs_rpls <- dataprep(nom_reg = "Pays de la Loire", choix_epci ="2- Liste d EPCI a saisir",
21		#' epci_list = c("244400404", "244400644")) %>%
22		#' dplyr::filter(Zone_ref)
23		#' }
24		#'
25		dataprep <- function(nom_reg = "Pays de la Loire", choix_epci ="1- Tous les EPCI de la zone", epci_list = NULL, test = FALSE) {
26
27	3x	if (test) {
28	3x	liste_depcom <- propre.rpls::tab_result %>%
29	3x	dplyr::pull("DEPCOM") %>%
30	3x	sample(size = 100)
31	3x	tab_result <- propre.rpls::tab_result %>%
32	3x	dplyr::filter(.data$DEPCOM %in% liste_depcom) %>%
33	3x	dplyr::mutate(millesime = factor(.data$millesime),
34	3x	DEPCOM = factor(.data$DEPCOM))
35	3x	lgt_rp <- propre.rpls::lgt_rp %>%
36	3x	dplyr::filter(DEPCOM %in% liste_depcom)
37		} else {
38	!	liste_depcom <- COGiter::communes %>% dplyr::pull("DEPCOM")
39	!	tab_result <- propre.rpls::tab_result %>%
40	!	dplyr::mutate(millesime = factor(.data$millesime),
41	!	DEPCOM = factor(.data$DEPCOM))
42	!	lgt_rp <- propre.rpls::lgt_rp
43		}
44
45	3x	id_reg <- propre.rpls::get_id_reg(nom_reg)
46
47	3x	epci_choisis <- propre.rpls::select_epci(nom_reg, choix_epci, epci_list)
48
49	3x	communes_departement_a_garder <- COGiter::liste_zone %>%
50	3x	dplyr::filter(.data$TypeZone %in% c("Communes","D\u00e9partements"), grepl(id_reg, as.character(.data$REG))) %>%
51	3x	mutate(CodeZone = as.character(.data$CodeZone)) %>%
52	3x	pull("CodeZone") %>%
53	3x	as.character()
54
55		# Ajout des zonages spé à l'Ile de France et AURA
56	3x	if(id_reg %in% c("11", "84")){
57	!	communes_departement_a_garder <- dplyr::filter(propre.rpls::zonage_spe, as.character(.data$REG) == id_reg) %>%
58	!	pull("CodeZone") %>%
59	!	unique() %>%
60	!	as.character() %>%
61	!	c(., communes_departement_a_garder) %>%
62		# On retire le departement du Rhone
63	!	setdiff(., "69")
64		}
65
66	3x	mil_disp <- dplyr::select(tab_result, "millesime") %>%
67	3x	dplyr::pull("millesime") %>%
68	3x	unique()
69		# Le df de départ, une ligne par commune à jour et millésime
70	3x	df <- tidyr::expand_grid(DEPCOM = liste_depcom, millesime = mil_disp)
71
72		# un df intermediaire pour pouvoir calculer les indicateurs de densite LS / RP pour toutes les annees
73		# (on duplique les données du RP pour chaque millesime disponible)
74	3x	lgt_rp_mil <- dplyr::full_join(df, lgt_rp, by = "DEPCOM") %>%
75	3x	dplyr::select(-"mil_RP", -"mil_RP_old", -"nb_an_evol_rp")
76		# une variable globale pour le nb d'annees d'ecart entre les mil du RP les plus récents pour le calcul des evolutions comparées RP/RPLS dans un dplyr::lag
77	3x	ecart_an_rp <- lgt_rp$nb_an_evol_rp[1]
78
79		# etape de construction du résultat :
80		# 1 - pour les indicateurs non sommables, on recalcule les composantes sommables
81		# 2 - pour les indicateurs à NA, on complète à 0
82		# 3 - passage des données tab_result sur le COG 2020
83		# 4 - fusion avec le fichier rp complet sur la liste des communes
84		# 5 - pour les communes non présentes dans tab_result, on met les indicateurs à 0
85		# 6 - cogification
86		# 7 - filtrage des données sur la région
87		# 8 - calcul des indicatrices pertinentes pour filtrer les données ensuite : Zone_ref et select_prov_drom
88		# 9 - recalcule des indicateurs non sommables
89		# 10 - suppression des variables non nécessaires
90	3x	res <- tab_result %>%
91	3x	dplyr::mutate(dplyr::across(where(is.numeric), ~ tidyr::replace_na(., 0))) %>%
92	3x	COGiter::passer_au_cog_a_jour(garder_info_supra = FALSE) %>%
93	3x	dplyr::full_join(lgt_rp_mil, by = c("DEPCOM", "millesime")) %>%
94	3x	dplyr::mutate(dplyr::across(where(is.numeric), ~ tidyr::replace_na(., 0))) %>%
95	3x	COGiter::cogifier(
96	3x	communes = TRUE, epci = TRUE, departements = TRUE, regions = TRUE,
97	3x	metro = TRUE, metrodrom = TRUE, franceprovince = TRUE, drom = TRUE) %>%
98	3x	COGiter::ajouter_zonage(zonage_df = propre.rpls::zonage_spe %>% dplyr::select(-"REG")) %>%
99	3x	dplyr::filter(!(TypeZone %in% c("Communes","D\u00e9partements", "EPT")) \| CodeZone %in% communes_departement_a_garder) %>%
100	3x	dplyr::mutate(
101	3x	Zone_ref = dplyr::case_when(
102	3x	.data$TypeZone == "R\u00e9gions" & .data$CodeZone == id_reg ~ TRUE,
103	3x	.data$TypeZone == "D\u00e9partements" ~ TRUE,
104	3x	.data$TypeZone == "France" ~ TRUE,
105	3x	.data$TypeZone == "EPT" ~ TRUE,
106	3x	.data$CodeZone %in% epci_choisis ~ TRUE,
107	3x	TRUE ~ FALSE),
108	3x	select_prov_drom = dplyr::case_when(
109	3x	id_reg %in% paste0("0", 1:6) & .data$CodeZone %in% c("FRMETRO", "FRPROV") ~ FALSE,
110	3x	id_reg %in% paste0("0", 1:6) & .data$TypeZone == "D\u00e9partements" ~ FALSE,
111	3x	!(id_reg %in% paste0("0", 1:6)) & .data$CodeZone %in% c("DROM", "FRMETRODROM") ~ FALSE,
112	3x	TRUE ~ TRUE),
113	3x	TypeZone = forcats::fct_relevel(.data$TypeZone, "Communes", "Epci", "EPT", "D\u00e9partements", "R\u00e9gions", "France"),
114		# Mettre au bon endroit les levels ajoutes avec ajouter_zonage
115	3x	CodeZone = forcats::fct_relevel(.data$CodeZone, sort)
116		) %>%
117	3x	dplyr::filter(.data$select_prov_drom) %>%
118	3x	dplyr::arrange(.data$TypeZone,.data$Zone,.data$CodeZone,.data$Zone_ref,.data$select_prov_drom,.data$millesime) %>%
119	3x	dplyr::group_by(.data$TypeZone,.data$Zone,.data$CodeZone,.data$Zone_ref,.data$select_prov_drom)
120	3x	res2 <- res %>%
121		# reconstitution des variables intensives
122	3x	dplyr::mutate(
123	3x	age_moyen = .data$age_somme / .data$nb_ls_age_connu,
124	3x	age_moyen_qpv = .data$age_somme_qpv / .data$nb_ls_qpv_age_connu,
125	3x	part_dpe_realise = .data$nb_ls_dpe_realise / .data$nb_ls_actif * 100,
126	3x	age_dpe_ener_A = .data$age_somme_dpe_ener_A / .data$nb_ls_age_connu_dpe_ener_A * 100,
127	3x	age_dpe_ener_B = .data$age_somme_dpe_ener_B / .data$nb_ls_age_connu_dpe_ener_B * 100,
128	3x	age_dpe_ener_C = .data$age_somme_dpe_ener_C / .data$nb_ls_age_connu_dpe_ener_C * 100,
129	3x	age_dpe_ener_D = .data$age_somme_dpe_ener_D / .data$nb_ls_age_connu_dpe_ener_D * 100,
130	3x	age_dpe_ener_E = .data$age_somme_dpe_ener_E / .data$nb_ls_age_connu_dpe_ener_E * 100,
131	3x	age_dpe_ener_F = .data$age_somme_dpe_ener_F / .data$nb_ls_age_connu_dpe_ener_F * 100,
132	3x	age_dpe_ener_G = .data$age_somme_dpe_ener_G / .data$nb_ls_age_connu_dpe_ener_G * 100,
133	3x	age_dpe_ener_new_A = .data$age_somme_dpe_ener_new_A / .data$nb_ls_age_connu_dpe_ener_new_A * 100,
134	3x	age_dpe_ener_new_B = .data$age_somme_dpe_ener_new_B / .data$nb_ls_age_connu_dpe_ener_new_B * 100,
135	3x	age_dpe_ener_new_C = .data$age_somme_dpe_ener_new_C / .data$nb_ls_age_connu_dpe_ener_new_C * 100,
136	3x	age_dpe_ener_new_D = .data$age_somme_dpe_ener_new_D / .data$nb_ls_age_connu_dpe_ener_new_D * 100,
137	3x	age_dpe_ener_new_E = .data$age_somme_dpe_ener_new_E / .data$nb_ls_age_connu_dpe_ener_new_E * 100,
138	3x	age_dpe_ener_new_F = .data$age_somme_dpe_ener_new_F / .data$nb_ls_age_connu_dpe_ener_new_F * 100,
139	3x	age_dpe_ener_new_G = .data$age_somme_dpe_ener_new_G / .data$nb_ls_age_connu_dpe_ener_new_G * 100,
140	3x	densite_ls_rp = .data$nb_ls_actif * 100 / .data$nb_rp,
141	3x	densite_ls_loues_rp = .data$nb_ls_loue * 100 / .data$nb_rp,
142	3x	evolution_rp = (.data$nb_rp - .data$nb_rp_old) * 100 / .data$nb_rp_old,
143	3x	evolution_n_nmoins1 = (.data$nb_ls_actif - dplyr::lag(.data$nb_ls_actif)) * 100 / dplyr::lag(.data$nb_ls_actif),
144	3x	evolution_annees_rp = (.data$nb_ls_actif - dplyr::lag(.data$nb_ls_actif, ecart_an_rp)) * 100 / dplyr::lag(.data$nb_ls_actif, ecart_an_rp),
145	3x	nb_ls_recent = .data$nb_piece_1_recent + .data$nb_piece_2_recent + .data$nb_piece_3_recent + .data$nb_piece_4_recent + .data$nb_piece_5_plus_recent,
146	3x	part_ls_qpv = .data$nb_ls_qpv / .data$nb_ls_actif * 100,
147	3x	part_ls_ind = .data$nb_ls_ind / .data$nb_ls_actif * 100,
148	3x	part_ls_coll = .data$nb_ls_coll / .data$nb_ls_actif * 100,
149	3x	part_ls_etu = .data$nb_ls_etu / .data$nb_ls_actif * 100,
150	3x	part_ls_oph = .data$nb_ls_oph / .data$nb_ls_actif * 100,
151	3x	part_ls_esh = .data$nb_ls_esh / .data$nb_ls_actif * 100,
152	3x	part_ls_sem = .data$nb_ls_sem / .data$nb_ls_actif * 100,
153	3x	part_ls_loue = .data$nb_ls_loue / .data$nb_ls_actif * 100,
154	3x	part_ls_vacant = .data$nb_ls_vacant / .data$nb_ls_actif * 100,
155	3x	part_ls_vide = .data$nb_ls_vide / .data$nb_ls_actif * 100,
156	3x	part_ls_association = .data$nb_ls_association / .data$nb_ls_actif * 100,
157	3x	part_ls_autre = .data$nb_ls_autre / .data$nb_ls_actif * 100,
158	3x	part_ls_recent = .data$nb_ls_recent / .data$nb_ls_actif * 100,
159	3x	part_ls_ind_recent = .data$nb_ls_ind_recent / .data$nb_ls_recent * 100,
160	3x	part_ls_coll_recent = .data$nb_ls_coll_recent / .data$nb_ls_recent * 100,
161	3x	part_ls_etu_recent = .data$nb_ls_etu_recent / .data$nb_ls_recent * 100,
162	3x	part_ls_qpv_ind = .data$nb_ls_ind_qpv / .data$nb_ls_qpv * 100,
163	3x	part_ls_qpv_coll = .data$nb_ls_coll_qpv / .data$nb_ls_qpv * 100,
164	3x	part_ls_qpv_etu = .data$nb_ls_etu_qpv / .data$nb_ls_qpv * 100,
165	3x	part_ls_1p = .data$nb_piece_1 / .data$nb_ls_actif * 100,
166	3x	part_ls_recent_1p = .data$nb_piece_1_recent / .data$nb_ls_recent * 100,
167	3x	part_ls_2p = .data$nb_piece_2 / .data$nb_ls_actif * 100,
168	3x	part_ls_recent_2p = .data$nb_piece_2_recent / .data$nb_ls_recent * 100,
169	3x	part_ls_3p = .data$nb_piece_3 / .data$nb_ls_actif * 100,
170	3x	part_ls_recent_3p = .data$nb_piece_3_recent / .data$nb_ls_recent * 100,
171	3x	part_ls_4p = .data$nb_piece_4 / .data$nb_ls_actif * 100,
172	3x	part_ls_recent_4p = .data$nb_piece_4_recent / .data$nb_ls_recent * 100,
173	3x	part_ls_5pp = .data$nb_piece_5_plus / .data$nb_ls_actif * 100,
174	3x	part_ls_recent_5pp = .data$nb_piece_5_plus_recent / .data$nb_ls_recent * 100,
175	3x	part_mes_qpv = .data$nb_mes_qpv / .data$nb_mes * 100,
176	3x	part_ls_age_0_4 = .data$nb_ls_age_0_5 / .data$nb_ls_actif * 100,
177	3x	part_ls_age_5_9 = .data$nb_ls_age_5_10 / .data$nb_ls_actif * 100,
178	3x	part_ls_age_10_19 = .data$nb_ls_age_10_20 / .data$nb_ls_actif * 100,
179	3x	part_ls_age_20_39 = .data$nb_ls_age_20_40 / .data$nb_ls_actif * 100,
180	3x	part_ls_age_40_59 = .data$nb_ls_age_40_60 / .data$nb_ls_actif * 100,
181	3x	part_ls_age_60p = .data$nb_ls_age_60_plus / .data$nb_ls_actif * 100,
182	3x	nb_ls_loues_proploc = .data$nb_ls_loue + .data$nb_ls_vacant,
183	3x	taux_vacance_tot = .data$nb_ls_vacant / .data$nb_ls_loues_proploc * 100,
184	3x	taux_vacance_str = .data$nb_ls_vacant_3 / .data$nb_ls_loues_proploc * 100,
185	3x	taux_mobilite = .data$num_mob / .data$denom_mob *100,
186	3x	taux_mobilite_1p = .data$num_mob_1_piece / .data$denom_mob_1_piece *100,
187	3x	taux_mobilite_2p = .data$num_mob_2_piece / .data$denom_mob_2_piece *100,
188	3x	taux_mobilite_3p = .data$num_mob_3_piece / .data$denom_mob_3_piece *100,
189	3x	taux_mobilite_4p = .data$num_mob_4_piece / .data$denom_mob_4_piece *100,
190	3x	taux_mobilite_5pp = .data$num_mob_5_piece / .data$denom_mob_5_piece *100,
191	3x	taux_vacance_str_0_4ans = .data$num_vac_struct_age_0_5 / .data$denom_vac_struct_age_0_5 * 100,
192	3x	taux_vacance_str_5_9ans = .data$num_vac_struct_age_5_10 / .data$denom_vac_struct_age_5_10 * 100,
193	3x	taux_vacance_str_10_19ans = .data$num_vac_struct_age_10_20 / .data$denom_vac_struct_age_10_20 * 100,
194	3x	taux_vacance_str_20_39ans = .data$num_vac_struct_age_20_40 / .data$denom_vac_struct_age_20_40 * 100,
195	3x	taux_vacance_str_40_59ans = .data$num_vac_struct_age_40_60 / .data$denom_vac_struct_age_40_60 * 100,
196	3x	taux_vacance_str_60ans_plus = .data$num_vac_struct_age_60_plus / .data$denom_vac_struct_age_60_plus * 100,
197	3x	taux_vacance_str_qpv = .data$num_vac_struct_qpv / .data$denom_vac_struct_qpv * 100,
198	3x	taux_vacance_str_hors_qpv = .data$num_vac_struct_horsqpv / .data$denom_vac_struct_horsqpv * 100,
199	3x	part_mes_plai = .data$nb_plai / .data$nb_mes * 100,
200	3x	part_mes_plus = .data$nb_plus / .data$nb_mes * 100,
201	3x	part_mes_pls = .data$nb_pls / .data$nb_mes * 100,
202	3x	part_mes_pli = .data$nb_pli / .data$nb_mes * 100,
203	3x	loyer_m2_plai = .data$somme_loyer_nb_plai / .data$somme_surface_nb_plai,
204	3x	loyer_m2_plus = .data$somme_loyer_nb_plus / .data$somme_surface_nb_plus,
205	3x	loyer_m2_pls = .data$somme_loyer_nb_pls / .data$somme_surface_nb_pls,
206	3x	loyer_m2_pli = .data$somme_loyer_nb_pli / .data$somme_surface_nb_pli,
207	3x	loyer_m2_plai_recent = .data$somme_loyer_nb_plai_recent / .data$somme_surface_nb_plai_recent,
208	3x	loyer_m2_plus_recent = .data$somme_loyer_nb_plus_recent / .data$somme_surface_nb_plus_recent,
209	3x	loyer_m2_pls_recent = .data$somme_loyer_nb_pls_recent / .data$somme_surface_nb_pls_recent,
210	3x	loyer_m2_pli_recent = .data$somme_loyer_nb_pli_recent / .data$somme_surface_nb_pli_recent,
211	3x	loyer_m2_plai_mes = .data$somme_loyer_nb_plai_mes / .data$somme_surface_nb_plai_mes,
212	3x	loyer_m2_plus_mes = .data$somme_loyer_nb_plus_mes / .data$somme_surface_nb_plus_mes,
213	3x	loyer_m2_pls_mes = .data$somme_loyer_nb_pls_mes / .data$somme_surface_nb_pls_mes,
214	3x	loyer_m2_pli_mes = .data$somme_loyer_nb_pli_mes / .data$somme_surface_nb_pli_mes,
215	3x	loyer_m2 = .data$somme_loyer / .data$somme_surface,
216	3x	loyer_m2_recent = .data$somme_loyer_recent / .data$somme_surface_recent,
217	3x	loyer_m2_qpv = .data$somme_loyer_enqpv / .data$somme_surface_enqpv,
218	3x	loyer_m2_mes = (.data$somme_loyer_nb_plai_mes + .data$somme_loyer_nb_plus_mes + .data$somme_loyer_nb_pls_mes + .data$somme_loyer_nb_pli_mes ) /
219	3x	(.data$somme_surface_nb_plai_mes + .data$somme_surface_nb_plus_mes + .data$somme_surface_nb_pls_mes + .data$somme_surface_nb_pli_mes),
220	3x	loyer_m2_0_4ans = .data$somme_loyer_age_inf_5 / .data$somme_surface_age_inf_5,
221	3x	loyer_m2_5_9ans = .data$somme_loyer_age_5_10 / .data$somme_surface_age_5_10,
222	3x	loyer_m2_10_19ans = .data$somme_loyer_age_10_20 / .data$somme_surface_age_10_20,
223	3x	loyer_m2_20_39ans = .data$somme_loyer_age_20_40 / .data$somme_surface_age_20_40,
224	3x	loyer_m2_40_59ans = .data$somme_loyer_age_40_60 / .data$somme_surface_age_40_60,
225	3x	loyer_m2_60ans_et_plus = .data$somme_loyer_age_60_plus / .data$somme_surface_age_60_plus,
226	3x	part_mes_qpv_plai = .data$nb_mes_plai_qpv / .data$nb_mes_qpv * 100,
227	3x	part_mes_qpv_plus = .data$nb_mes_plus_qpv / .data$nb_mes_qpv * 100,
228	3x	part_mes_qpv_pls = .data$nb_mes_pls_qpv / .data$nb_mes_qpv * 100,
229	3x	part_mes_qpv_pli = .data$nb_mes_pli_qpv / .data$nb_mes_qpv * 100,
230	3x	part_plai_acq_av_travaux = .data$nb_plai_acq_av_travaux / .data$nb_plai * 100,
231	3x	part_plai_acq_ss_travaux = .data$nb_plai_acq_ss_travaux / .data$nb_plai * 100,
232	3x	part_plai_acq_vefa = .data$nb_plai_acq_vefa / .data$nb_plai * 100,
233	3x	part_plai_construit_org = .data$nb_plai_construit_org / .data$nb_plai * 100
234		) %>%
235	3x	dplyr::ungroup() %>%
236	3x	dplyr::select(-"select_prov_drom")
237
238	3x	return(res2)
239
240		}
241
242

1		#' Trouve les chemins des fichiers du package propre.rpls
2		#'
3		#' Renvoie les adresses absolues des fichiers presents dans le repertoire d'installation du package a partir de leur adresse relative.
4		#' @param ... Une ou plusieurs chaines de caracteres, representant les noms de fichiers ou repertoires a rechercher dans le package.
5		#' @return Un chemin absolu.
6		#' @examples
7		#' propre.rpls_file('rstudio', 'templates', 'project', 'ressources')
8		#'
9		#' @export
10		propre.rpls_file <- function(...) {
11	37x	system.file(..., package = 'propre.rpls', mustWork = TRUE)
12		}
13
14
15		#' Fonction de creation du repertoire du projet de l'utilisateur
16		#'
17		#' A partir de la saisie des parametres par l'utilisateur, cette fonction peuple le repertoire de travail de l'utilisateur avec
18		#' le bookdown et fixe les parametres yaml dans `index.Rmd`.
19		#'
20		#' @param path Repertoire du projet de publication saisi par l'utilisateur.
21		#' @param ... Autres parametres saisis par l'utilisateur (region, epci, millesime).
22		#' @return TRUE
23		#' @examples
24		#' \dontrun{
25		#' propre.rpls_skeleton("rpls2019bretagne", annee="2019",
26		#' epci_ref="1- Tous les EPCI de la zone", nom_region="Bretagne")
27		#' }
28		#'
29		#' @importFrom xfun read_utf8 write_utf8
30		#' @importFrom propre.datareg datareg
31		#' @export
32		propre.rpls_skeleton <- function(path,...) {
33
34		# bloquer la creation si projet existant
35	2x	if(file.exists(path)) {
36	1x	message(paste0("le dossier '", path, "' existe deja\nveuillez le supprimer ou changer de nom de dossier\nRstudio ouvre l'ancien projet"))
37		}
38
39		else {
40
41		# Creer le repertoire de travail
42	1x	dir.create(path, recursive = TRUE, showWarnings = FALSE)
43	1x	dir.create(file.path(path, "extdata"), showWarnings = FALSE)
44	1x	dir.create(file.path(path, "www"), showWarnings = FALSE)
45		# Copier le dossier 'resources' vers le repertoire de travail utilisateur
46	1x	resources <- propre.rpls_file('rstudio', 'templates', 'project', 'ressources')
47
48	1x	files <- list.files(resources, recursive = FALSE, include.dirs = FALSE)
49
50	1x	source <- file.path(resources, files)
51	1x	target <- file.path(path, files)
52	1x	file.copy(source, target)
53
54		# Copier le dossier 'resources/extdata' vers le repertoire de travail utilisateur
55	1x	res_data <- propre.rpls_file('rstudio', 'templates', 'project', 'ressources', 'extdata')
56	1x	data_files <- list.files(res_data, recursive = FALSE, include.dirs = FALSE)
57	1x	source <- file.path(res_data, data_files)
58	1x	target <- file.path(path, "extdata", data_files)
59	1x	file.copy(source, target)
60
61
62		# Ajouter le nom du projet utilisateur en tant que titre du bookdown dans _bookdown.yml
63	1x	f <- file.path(path, '_bookdown.yml')
64	1x	x <- xfun::read_utf8(f)
65	1x	xfun::write_utf8(c(sprintf('book_filename: "%s"', basename(path)), x), f)
66
67
68		# Collecter les inputs utilisateurs et les assembler comme \"parametre: valeur"
69	1x	dots <- list(...)
70
71	1x	text <- lapply(seq_along(dots), function(i) {
72	3x	key <- names(dots)[[i]]
73	3x	val <- dots[[i]]
74	3x	paste0(" ", key, ": ", "\"",val, "\"")
75		})
76
77		# Gérer les types d analyses par epci en proposant une liste d'EPCI à adapter si choix 2
78
79	1x	if(grepl("2- ", dots$epci_ref)) {
80	!	list_epci <- " epci_list: !r c(\"244400404\",\"244400644\",\"244900015\",\"245300330\",\"247200132\",\"248500589\",\"200071678\",\"200071876\",\"244400610\",\"200071165\")"
81		} else {
82	1x	list_epci <- " "
83		}
84
85		# Assembler les parametres collectes dans une unique chaine de caracteres et declarer son encodage
86	1x	contents <- paste("params:",
87	1x	paste(text, collapse = "\n"),
88	1x	list_epci, sep = "\n")
89	1x	Encoding(contents) <- "UTF-8"
90
91
92		# Injecter les parametres dans le fichier index.Rmd
93	1x	conn <- file.path(path,"index.Rmd")
94	1x	text <- xfun::read_utf8(conn)
95	1x	mytext <- c(text[1:8],contents,text[(8+1):length(text)])
96	1x	xfun::write_utf8(mytext, conn, sep="\n")
97
98		# Injecter le logo
99	1x	reg <- dots$nom_region
100	1x	id_reg <- get_id_reg(nom_reg = reg)
101	1x	logo <- paste0("prefecture_r", id_reg)
102	1x	logo_file_path <- gouvdown::logo_file_path(logo)
103	1x	file_ext <- xfun::file_ext(logo_file_path)
104	1x	target_file <- paste("logo",file_ext,sep=".")
105	1x	target <- file.path(path, "www", target_file)
106	1x	file.copy(logo_file_path, target)
107	1x	content <- sprintf(' <li><a href="./"><img src="www/%s" width = "130"></a></li>', target_file)
108	1x	f <- file.path(path, "_output.yml")
109	1x	x <- xfun::read_utf8(f)
110	1x	output <- c(x[1:5], content, x[6:length(x)])
111	1x	xfun::write_utf8(output, f)
112
113		# Injecter les css
114	1x	css_dir <- system.file("resources", "css", package = "gouvdown", mustWork = TRUE)
115	1x	css_files <- list.files(css_dir)
116	1x	source <- file.path(css_dir, css_files)
117	1x	target <- file.path(path, css_files)
118	1x	file.copy(source, target)
119
120		# Injecter le mail de contact, le titre millésimé et la région de publication dans _output.yml
121	1x	mail <- propre.datareg::datareg(code_reg = id_reg)$courriel_contact
122	1x	complmt_reg <- propre.datareg::datareg(code_reg = id_reg)$en_de_nom_region
123	1x	f <- file.path(path, '_output.yml')
124	1x	x <- xfun::read_utf8(f)
125	1x	contents <- sprintf(" <li><a href='./'>Le parc social en %s</a></li>", dots[[1]]) # dots sont les paramètres utilisateurs, le premier est le millesime
126	1x	x[9] <- gsub("mailto:", paste0("mailto:", mail, "?Publication RPLS ", dots[[1]]), x[9])
127	1x	output <- c(x[1:6], contents, x[(5+3):length(x)])
128	1x	xfun::write_utf8(output, f)
129
130	1x	TRUE
131		}
132		}

1		#' @title Chapitre 5 : Verbatim
2		#'
3		#' @description Production des commentaires verbatim du chapitre 5.
4		#'
5		#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref
6		#' @param annee Le millésime renseigné par l'utilisateur (au format numérique)
7		#'
8		#' @return Un vecteur de 2 chaînes de caractères comprenant l'intertitre et les commentaires essentiels du chapitre 5
9		#'
10		#' @importFrom dplyr across filter pull mutate select arrange summarise first last case_when
11		#' @importFrom glue glue
12		#' @importFrom propre.datareg datareg maj1let
13		#' @importFrom tidyr pivot_wider
14		#' @importFrom rlang .data
15		#'
16		#' @export
17		#'
18		#' @examples
19		#' indic_rpls_ref <- propre.rpls::lire_rpls_exemple() %>%
20		#' dplyr::filter(Zone_ref)
21		#'
22		#' creer_verbatim_5(data = indic_rpls_ref, annee = 2019)[["intertitre"]]
23		#' creer_verbatim_5(data = indic_rpls_ref, annee = 2019)[["commentaires"]]
24
25
26		creer_verbatim_5 <- function(data, annee) {
27
28		# calcul annee de depart des evolutions
29	3x	annee_old <- annee - 4
30
31		# Récupération des formulations idiomatiques grâce à {propre.datareg} et autres info sur la region etudiee
32	3x	id_reg <- dplyr::filter(data, grepl("gions", .data$TypeZone)) %>%
33	3x	dplyr::pull("CodeZone") %>%
34	3x	unique() %>% as.character()
35	3x	verb_reg <- propre.datareg::datareg(code_reg = id_reg)
36	3x	reg_om <- (id_reg %in% paste0("0", 1:6))
37
38		# Création de la table avec tous les indicateurs calculés
39	3x	vac_mob_0 <- data %>%
40		# Filtre pour ne conserver que les données de l'année choisie, de la région choisie et de la maille nationale (FRMETRO ou FRMETRODROM)
41	3x	dplyr::filter(.data$millesime %in% c(annee, annee_old), grepl("gions", .data$TypeZone) \| grepl("FRMETRO", .data$CodeZone)) %>%
42		# Création de variables utiles, notamment indicateurs calculés
43	3x	dplyr::mutate(TypeZone = substr(.data$TypeZone, 1, 1),
44	3x	taux_vac = .data$taux_vacance_tot,
45	3x	taux_vac_3 = .data$taux_vacance_str,
46	3x	taux_mob = .data$taux_mobilite) %>%
47		# sélection des variables utiles
48	3x	dplyr::select("TypeZone", "millesime", "nb_ls_loues_proploc", "nb_ls_vacant",
49	3x	"taux_vac", "nb_ls_vacant_3", "taux_vac_3", "taux_mob")
50
51	3x	vac_mob <- dplyr::filter(vac_mob_0, .data$millesime == annee) %>%
52		# Passage du format long au format large
53	3x	tidyr::pivot_wider(names_from = "TypeZone", values_from = c("nb_ls_loues_proploc", "nb_ls_vacant", "taux_vac",
54	3x	"nb_ls_vacant_3", "taux_vac_3", "taux_mob")) %>%
55		# Création des variables relatives aux noms des mailles régionale (nom région) et nationale (FRMETRO ou FRMETRODROM)
56	3x	dplyr::mutate(nomzone = ifelse(reg_om, "sur l\u2019ensemble de la France", "en France m\u00e9tropolitaine"))
57
58	3x	evol_vac_mob <- vac_mob_0 %>%
59	3x	dplyr::filter(.data$TypeZone == "R") %>%
60	3x	dplyr::arrange(.data$millesime) %>%
61	3x	dplyr::summarise(
62	3x	taux_mob_r_old = dplyr::first(.data$taux_mob) %>% round(1),
63	3x	taux_mob_r_actu = dplyr::last(.data$taux_mob) %>% round(1),
64	3x	taux_vac_3_r_old = dplyr::first(.data$taux_vac_3) %>% round(1),
65	3x	taux_vac_3_r_actu = dplyr::last(.data$taux_vac_3) %>% round(1),
66		) %>%
67	3x	dplyr::mutate(
68	3x	ecart_mob = .data$taux_mob_r_actu - .data$taux_mob_r_old,
69	3x	ecart_vac3 = .data$taux_vac_3_r_actu - .data$taux_vac_3_r_old,
70	3x	dplyr::across(.cols = c("ecart_mob", "ecart_vac3"), .names = "{.col}_fmt",
71	3x	.fns = ~ paste0( "de ", format_fr_nb(x = abs(.x), dec = 1), " point")),
72	3x	verb_mob = dplyr::case_when(.data$ecart_mob < 0 ~ glue::glue("a baiss\u00e9 {.data$ecart_mob_fmt}"),
73	3x	.data$ecart_mob == 0 ~ "est rest\u00e9e stable",
74	3x	.data$ecart_mob > 0 ~ glue::glue("a progress\u00e9 {.data$ecart_mob_fmt}")),
75	3x	verb_vac3 = dplyr::case_when(.data$ecart_vac3 < 0 ~ glue::glue("a diminu\u00e9 {.data$ecart_vac3_fmt}"),
76	3x	.data$ecart_vac3 > 0 ~ glue::glue("a augment\u00e9 {.data$ecart_vac3_fmt}"),
77	3x	.data$ecart_vac3 == 0 ~ "est rest\u00e9e stable")) %>%
78	3x	dplyr::mutate(verb_mob = ifelse(abs(.data$ecart_mob) > 1, paste0(.data$verb_mob, "s"), .data$verb_mob),
79	3x	verb_vac3 = ifelse(abs(.data$ecart_vac3) > 1, paste0(.data$verb_vac3, "s"), .data$verb_vac3))
80
81
82
83		# Création de liste avec tous les paramètres utiles au commentaire
84	3x	verb5 <- list(nb_vac_reg = vac_mob$nb_ls_vacant_R %>% format_fr_nb(dec = 0),
85	3x	nb_vac_3_reg = vac_mob$nb_ls_vacant_3_R %>% format_fr_nb(dec = 0),
86	3x	annee = annee,
87	3x	nb_ls_loues_proploc_reg = vac_mob$nb_ls_loues_proploc_R %>% format_fr_nb(dec = 0),
88	3x	region = verb_reg$dans_la_region_nom_region,
89	3x	taux_vac_reg = vac_mob$taux_vac_R %>% format_fr_pct,
90	3x	taux_vac_fr = vac_mob$taux_vac_F %>% format_fr_pct,
91	3x	france = vac_mob$nomzone,
92	3x	taux_vac_3_reg = vac_mob$taux_vac_3_R %>% format_fr_pct,
93	3x	taux_vac_3_fr = vac_mob$taux_vac_3_F %>% format_fr_pct,
94	3x	evol_vac3 = evol_vac_mob$verb_vac3,
95	3x	annee_old = annee - 4,
96	3x	annee_moins1 = annee - 1,
97	3x	taux_mob_reg = vac_mob$taux_mob_R %>% format_fr_pct,
98	3x	taux_mob_fr = vac_mob$taux_mob_F %>% format_fr_pct,
99	3x	evol_mob = evol_vac_mob$verb_mob,
100	3x	loc_intertitre = verb_reg$dans_la_region)
101
102
103		# Production du verbatim
104	3x	verbatim_chap_5 <- list(intertitre ="", commentaires ="")
105
106	3x	verbatim_chap_5$intertitre <- if (verb5$nb_vac_reg == "0") {
107	!	glue::glue("Au 1er janvier ", {verb5$annee}, ", aucun logement social n\'est vacant {verb5$loc_intertitre}.")
108		} else {
109	3x	glue::glue("{propre.datareg::maj1let(verb5$loc_intertitre)}, {verb5$nb_vac_reg} logements sont vacants et ",
110	3x	"{verb5$nb_vac_3_reg} le sont depuis plus de trois mois.")
111		}
112
113		#phrase 1
114	3x	phrase1 <- "Au 1er janvier {verb5$annee}, parmi les {verb5$nb_ls_loues_proploc_reg} logements lou\u00e9s ou propos\u00e9s \u00e0 la location {verb5$region}, "
115	3x	if (verb5$nb_vac_reg == "0"){
116	!	phrase1 <- glue::glue(phrase1, "aucun n\'est vacant, contre {verb5$taux_vac_fr} {verb5$france}.")
117	3x	} else if (verb5$taux_vac_reg != verb5$taux_vac_fr) {
118	3x	phrase1 <- glue::glue(phrase1, "{verb5$taux_vac_reg} sont vacants, contre {verb5$taux_vac_fr} {verb5$france}.")
119		} else {
120	!	phrase1 <- glue::glue(phrase1, "{verb5$taux_vac_reg} sont vacants, comme {verb5$france}.")
121		}
122
123		#phrase 2
124	3x	phrase2 <- " La vacance de plus de trois mois, dite \u00ab vacance structurelle \u00bb est de {verb5$taux_vac_3_reg}, "
125	3x	if (verb5$nb_vac_reg == "0"){
126	!	phrase2 <- glue::glue("")
127	3x	} else if (verb5$taux_vac_3_reg != verb5$taux_vac_3_fr) {
128	3x	phrase2 <- glue::glue(phrase2, "contre {verb5$taux_vac_3_fr} au niveau national. ")
129		} else {
130	!	phrase2 <- glue::glue(phrase2, "comme au niveau national. ")
131		}
132
133		#phrase 3
134	3x	phrase3 <- glue::glue("Elle {verb5$evol_vac3} entre {verb5$annee_old} et {verb5$annee}. ")
135
136		#phrase 4
137	3x	phrase4 <- "En {verb5$annee_moins1}, {verb5$taux_mob_reg} de logements ont chang\u00e9 de locataires, "
138	3x	if (verb5$taux_mob_reg != verb5$taux_mob_fr){
139	3x	phrase4 <- glue::glue(phrase4, "contre {verb5$taux_mob_fr} {verb5$france}. ")
140		} else {
141	!	phrase4 <- glue::glue(phrase4, "comme {verb5$france}. ")
142		}
143
144		#phrase 5
145	3x	phrase5 <- glue::glue("La mobilit\u00e9 {verb5$evol_mob} entre {verb5$annee_old} et {verb5$annee}. ")
146
147
148		# Renvoi du résultat
149	3x	verbatim_chap_5$commentaires <- glue::glue("{phrase1}{phrase2}{phrase3}\n\n{phrase4}{phrase5}")
150
151	3x	verbatim_chap_5
152
153		}

1		#' Ouvrir l'application de consultation des indicateurs complementaires
2		#' @param nom_reg Le nom de la région sur laquelle vous souhaitez que l'application se lance.
3		#' @param clean TRUE si vous voulez recalculer les données.
4		#' @importFrom rappdirs user_data_dir
5		#' @importFrom tidyr pivot_longer pivot_wider
6		#' @importFrom dplyr left_join mutate select bind_rows filter
7		#' @importFrom utils read.csv2
8		#' @return a shiny app
9		#' @export
10		#'
11
12		run_rpls_explorer <- function(nom_reg = "53 Bretagne", clean = FALSE) {
13
14	!	df_path <- file.path(rappdirs::user_data_dir("propre.rpls"),"propre_rpls.RData")
15
16	!	if (!file.exists(df_path) \| clean) {
17
18	!	if (!dir.exists(rappdirs::user_data_dir("propre.rpls"))) {dir.create(rappdirs::user_data_dir("propre.rpls"), recursive = TRUE)}
19
20	!	liste_var_avec_libelle <- utils::read.csv2(propre.rpls::propre.rpls_file('rstudio/templates/project/ressources/extdata/dico_var.csv'), fileEncoding = "UTF-8")
21
22	!	liste_var_avec_libelle_compl <- utils::read.csv2(propre.rpls::propre.rpls_file('rstudio/templates/project/ressources/extdata/dico_var_compl.csv'), fileEncoding = "UTF-8")
23
24	!	liste_var_avec_libelle_rp <- utils::read.csv2(propre.rpls::propre.rpls_file('rstudio/templates/project/ressources/extdata/dico_var_rp.csv'), fileEncoding = "UTF-8") %>%
25		# suppression des variables sur les millésimes du RP, qui ne figurent pas dans le resultat de dataprep()
26	!	dplyr::filter(!(.data$nom_court %in% c("mil_RP", "mil_RP_old", "nb_an_evol_rp")))
27
28	!	liste_var_avec_libelle <- dplyr::bind_rows(liste_var_avec_libelle, liste_var_avec_libelle_compl, liste_var_avec_libelle_rp) %>%
29	!	dplyr::mutate(Chapitre = as.factor(.data$Chapitre))
30
31	!	propre_rpls <- dataprep(nom_reg = nom_reg) %>%
32	!	dplyr::filter((.data$TypeZone == "Communes" & .data$nb_logt_total > 0) \| .data$TypeZone != "Communes") %>%
33	!	tidyr::pivot_longer(cols = -c("TypeZone", "Zone", "Zone_ref", "CodeZone", "millesime"),
34	!	names_to = "nom_court", values_to = "valeur") %>%
35	!	dplyr::left_join(liste_var_avec_libelle %>%
36	!	dplyr::select("nom_court", "libelles")) %>%
37	!	dplyr::select(-"nom_court") %>%
38	!	tidyr::pivot_wider(names_from = "libelles", values_from = "valeur")
39
40	!	save(propre_rpls, liste_var_avec_libelle, file = df_path)
41		}
42
43	!	appDir <- system.file("shiny", package = "propre.rpls")
44
45	!	if (appDir == "") {
46	!	stop("Could not find app directory. Try re-installing `{propre.rpls}`.", call. = FALSE)
47		}
48
49	!	shiny::runApp(appDir, display.mode = "normal")
50		}

1		#' get_dataprep : recuperer les resultats de la precedente execution de la datapreparation
2		#'
3		#' Cette fonction evite de lancer plusieurs fois la fonction de preparation des données `dataprep()` en sauvegardant le resultat de son execution.
4		#' Cela pouvait s'averer fastidieux en cas de compilations repetees de la publication.
5		#' La datapreparation ne s'execute qu'en cas de 1ere execution ou de souhait de mise a jour des indicateurs
6		#' (utile si par exemple le package a evolue au niveau des donnees, ou si on change des parametres utilisateurs comme la liste des EPCI de reference, la region ou le millesime).
7		#'
8		#' @param maj Booleen pour indiquer si on souhaite mettre a jour les donnees en relancant la fonction de datapreparation.
9		#' @param par_util La liste des parametres utilisateurs de la publication (params).
10		#' @param test Booleen qui indique si on souhaite executer la version de test de datapreparation.
11		#' @param ext_dir Le repertoire d'export des donnees en RData, sera cree si inexistant. Par defaut le repertoire de travail courant.
12		#'
13		#' @return Un dataframe d'indicateurs : une ligne par entite geographique et millesime, le champ Zone_ref permet de filtrer les territoires pour ne conserver que ceux a inclure dans les illustrations.
14		#' @export
15		#'
16		#' @examples
17		#' get_dataprep(maj = FALSE, test = TRUE, ext_dir = tempdir(),
18		#' par_util = list(nom_region = "Bretagne", epci_ref = "3- ", epci_list = NULL))
19		get_dataprep <- function(maj = FALSE, par_util = list(nom_region = "Bretagne", epci_ref = "3- ", epci_list = NULL),
20		test = FALSE, ext_dir = ".") {
21	2x	dir.create(ext_dir, recursive = TRUE, showWarnings = FALSE)
22	2x	dataset <- "indicateurs_rpls"
23	2x	rdata <- paste0(ext_dir, "/", dataset, ".RData")
24
25	2x	if(file.exists(rdata) & !maj) {
26	1x	load(rdata)
27	1x	return(indicateurs_rpls)
28		} else {
29	1x	df <- propre.rpls::dataprep(par_util$nom_region, choix_epci = par_util$epci_ref, epci_list = par_util$epci_list, test = test)
30	1x	assign(dataset, df)
31	1x	save("indicateurs_rpls", file = rdata)
32	1x	return(df)
33		}
34		}
35
36		#' get_fond_carto : recuperer les resultats de la precedente execution de la preparation du fond carto
37		#'
38		#' Cette fonction evite de lancer plusieurs fois la fonction de preparation du fond carto `fond_carto()`, en exportant le resultat de son execution.
39		#' Cela pouvait s'averer fastidieux en cas de compilations repetees de la publication.
40		#' La preparation du fond carto ne s'execute qu'en cas de 1ere execution ou de souhait de mise a jour.
41		#'
42		#' @param maj Booleen pour indiquer si on souhaite mettre a jour les donnees en relancant la fonction de datapreparation.
43		#' @param par_util La liste des parametres utilisateurs de la publication (params).
44		#' @param ext_dir Le repertoire d'export des donnees en RData, sera cree si inexistant. Par defaut le repertoire de travail courant.
45		#' @param ... Autres parametres de la fonction \code{mapfactory::\link{fond_carto}}.
46		#'
47		#' @return Le fond_carto, ie une liste de dataframes geographiques sf.
48		#' @export
49		#'
50		#' @examples
51		#' get_fond_carto(maj = FALSE, par_util = list(nom_region = "Bretagne"), ext_dir = tempdir())
52		get_fond_carto <- function(maj = FALSE, par_util = list(nom_region = "Bretagne"), ext_dir = ".", ...) {
53	2x	dir.create(ext_dir, recursive = TRUE, showWarnings = FALSE)
54	2x	dataset <- "fond_carto"
55	2x	rdata <- paste0(ext_dir, "/", dataset, ".RData")
56	2x	if(file.exists(rdata) & !maj) {
57	1x	load(rdata)
58	1x	return(fond_carto)
59		} else {
60	1x	df <- mapfactory::fond_carto(par_util$nom_region, ...)
61	1x	assign(x = dataset, value = df)
62	1x	save("fond_carto", file = rdata)
63	1x	return(df)
64		}
65		}
66

1		#' Creer la sortie pdf d une publication html
2		#' `r lifecycle::badge("experimental")`
3		#'
4		#' Permet de compiler le book (si celui-ci ne l a pas deja ete) et d en produire la sortie en pdf dans le repertoire du book.
5		#'
6		#' @param chemin_book Chemin du book html a convertir en pdf, vaut par defaut "_book/" (= repertoire de compilation de la publication par defaut). Le book sera compile si chemin_book n'existe pas.
7		#' @param nom_pdf Nom du fichier pdf a creer, par defaut "book_complet.pdf".
8		#' @param pages_html Vecteur des noms de chapitres du book html a integrer dans le fichier pdf, dans l'ordre souhaite. Par defaut c("index", "Chapo", "evolparc", "caractparc", "mouvmts", "dpe", "tension", "loyers", "methodo", "mentionslegales") ce qui correspond aux noms des pages html par defaut.
9		#' @param scale le facteur de mise a l'echelle, 0.9 par defaut
10		#'
11		#' @return file pdf
12		#'
13		#' @importFrom attempt stop_if_any
14		#' @importFrom glue glue
15		#' @importFrom pagedown chrome_print
16		#' @importFrom purrr map
17		#' @importFrom qpdf pdf_combine
18		#' @importFrom rmarkdown render_site
19		#' @export
20		#'
21		#' @examples
22		#' \dontrun{
23		#' creer_pdf_book()
24		#' }
25		creer_pdf_book <- function(chemin_book = "_book/", nom_pdf = "book_complet.pdf",
26		pages_html = c("index", "Chapo", "evolparc", "caractparc", "mouvmts", "dpe",
27		"tension", "loyers", "methodo", "mentionslegales"),
28		scale = 0.9){
29
30	1x	if(!dir.exists(chemin_book)){
31		# si le book n'existe pas encore
32	!	message(glue::glue("Le repertoire {chemin_book} n'existe pas, creation au prealable de la publication au format html."))
33	!	rmarkdown::render_site(encoding = 'UTF-8')
34	!	chemin_book = "_book/"
35		} else {
36		# une precaution au cas où l'utilisateur oublierait le '/'
37	1x	chemin_book <- paste0(chemin_book, ("/"))
38		}
39
40		# liste des fichiers
41	1x	pages_html <- gsub(".html$", "", pages_html) # precaution : on enlève l'extension si l'utilisateur l'a saisie
42	1x	pages_html <- paste0(chemin_book, pages_html, ".html") # puis on la rajoute
43	1x	pages_pdf <- gsub(".html", ".pdf", pages_html)
44
45		# verification de la presence de tous les fichiers html necessaire a la sortie pdf
46	1x	attempt::stop_if_any(!file.exists(pages_html),
47	1x	msg = glue::glue("Il manque au moins un fichier html dans {chemin_book} ou il y a probleme de nommage, revoyez l'argument 'pages_html'."))
48
49		# chrome_print ne fonctionne que si il a un fichier nomme style.css.
50	!	file.copy(from = paste0(chemin_book, "gouv_book.css"), to = paste0(chemin_book, "style.css") )
51
52	!	message("Export des pages html au format PDF en cours :")
53	!	impress <- function(page, echelle = scale) {
54	!	message(glue::glue("- {page}"))
55	!	pagedown::chrome_print(input = page, extra_args = c('--disable-gpu', '--no-sandbox'), verbose = 0,
56	!	timeout = 600, options = list(transferMode = 'ReturnAsStream', scale = echelle))
57		}
58	!	purrr::map(.x = pages_html, .f = impress)
59
60
61		#Compilation des pdf pour obtenir le book complet en pdf
62	!	qpdf::pdf_combine(pages_pdf, output = glue::glue("{chemin_book}{nom_pdf}"))
63
64		# suppresion des fichiers pdf crees separement et du fichier style.css
65	!	file.remove(pages_pdf, glue::glue("{chemin_book}style.css"))
66	!	suppressWarnings(file.remove(glue::glue("{chemin_book}404.pdf")))
67
68	!	message(glue::glue("Le fichier {nom_pdf} est disponible dans {chemin_book}."))
69		}

1		#' Mentionne la ou les sources dans les illustrations.
2		#'
3		#' @param sources Un entier egal à 1 ou 2, 1 pour la source RPLS seule, 2 pour RPLS et RP INSEE
4		#' @param mil_rpls Une annee parmi les millesimes selectionnables par l'utilisateur, au format numerique.
5		#'
6		#' @return Une chaine de texte
7		#' @export
8		#'
9		#' @examples
10		#' caption(sources = 1, mil_rpls = 2018)
11		#'
12		#'
13
14		caption <- function(sources = 1, mil_rpls = 2020){
15
16	33x	lib_rpls <- paste0("SDES, RPLS au 1er janvier ", mil_rpls)
17	33x	lib_rp <- paste0("INSEE, recensement de la population ", lgt_rp$mil_RP[1])
18
19	33x	if(sources == 1) {
20	30x	lib <- paste0("Source : ", lib_rpls)
21		}
22
23	33x	if(sources == 2) {
24	3x	lib <- paste0("Sources : ", lib_rpls, " ; ", lib_rp)
25		}
26
27	33x	lib
28		}

1		#' Chapitre 2: Verbatim
2		#'
3		#' @description Production des commentaires verbatim du chapitre 2.
4
5		#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref
6		#' @param annee Le millesime renseigné par l'utilisateur (au format numérique)
7		#'
8		#' @return Un vecteur de 2 chaînes de caractères comprenant l'intertitre et les commentaires essentiels du chapitre 2
9		#'
10		#' @importFrom dplyr across case_when contains filter matches mutate pull select starts_with
11		#' @importFrom glue glue
12		#' @importFrom propre.datareg datareg maj1let
13		#' @importFrom rlang .data
14		#' @importFrom tidyr pivot_longer pivot_wider
15		#'
16		#' @export
17		#'
18		#' @examples
19		#' indic_rpls_ref <- propre.rpls::lire_rpls_exemple() %>%
20		#' dplyr::filter(Zone_ref)
21		#'
22		#' creer_verbatim_2(data = indic_rpls_ref, annee = 2019)[["intertitre"]]
23		#' creer_verbatim_2(data = indic_rpls_ref, annee = 2019)[["commentaires"]]
24
25		creer_verbatim_2 <- function(data, annee) {
26		# récupération du code région
27	3x	id_reg <- dplyr::filter(data, grepl("gions", .data$TypeZone)) %>%
28	3x	dplyr::pull("CodeZone") %>% unique() %>% as.character()
29
30		# on calcule d'abord les indicateurs necessaires aux commentaires - table de donnees communes
31	3x	amorce <- data %>%
32		# on garde : Fce metro si reg metropolitaine (CodeZone FRMETRO") ou Fce entiere si DROM (CodeZone FRMETRODROM) + FRPROV pour lgt etudiant en idf
33	3x	dplyr::filter(.data$millesime == annee, grepl("gions", .data$TypeZone) \| .data$CodeZone %in% c("FRPROV", "FRMETRO", "FRMETRODROM")) %>%
34	3x	dplyr::select("millesime", "CodeZone", "TypeZone", "nb_ls_actif",
35	3x	"part_ls_ind", "part_ls_coll", # intertitre et commentaire §4
36	3x	"nb_ls_loue","nb_ls_vacant","nb_ls_vide", "nb_ls_association","nb_ls_autre", # commentaire § 2
37	3x	"nb_ls_etu", "part_ls_etu", # commentaire § 3
38	3x	"partLs_oph" = "part_ls_oph", "partLs_esh" = "part_ls_esh", "partLs_sem" = "part_ls_sem", "nb_ls_autres_cat", # commentaire 1er §
39	3x	dplyr::matches("^nb_piece_[[:digit:]].*"), "nb_ls_ind_recent", "nb_ls_recent", "part_ls_ind_recent" ) %>% # commentaire 4e §
40	3x	dplyr::mutate(TypeZone = substr(.data$TypeZone, 1, 1), # on simplifie le lib de niv geo pour limiter les soucis d'encodage
41		# commentaire 2e §
42	3x	nb_ls_hors_marche = .data$nb_ls_vide + .data$nb_ls_association + .data$nb_ls_autre,
43	3x	part_ls_hors_marche = 100 * .data$nb_ls_hors_marche / .data$nb_ls_actif,
44		# commentaire 1er §
45	3x	partLs_autre = .data$nb_ls_autres_cat / .data$nb_ls_actif * 100,
46		# commentaire 5e §
47	3x	part_1_2_pieces = 100 * (.data$nb_piece_1 + .data$nb_piece_2) / .data$nb_ls_actif,
48	3x	part_1_2_pieces_recent = 100 * (.data$nb_piece_1_recent + .data$nb_piece_2_recent) / .data$nb_ls_recent,
49	3x	part_5_pieces_et_plus = 100 * .data$nb_piece_5_plus / .data$nb_ls_actif,
50	3x	part_5_pieces_et_plus_recent = 100 * .data$nb_piece_5_plus_recent / .data$nb_ls_recent,
51	3x	dplyr::across(dplyr::starts_with("part_"), ~round(.x, 1)))
52
53	3x	ligne_reg <- dplyr::filter(amorce, .data$TypeZone == "R")
54
55		# intertitre et 4e §
56	3x	indiv_coll <- amorce %>%
57	3x	dplyr::filter(.data$CodeZone != "FRPROV") %>%
58	3x	tidyr::pivot_wider(id_cols = "millesime", names_from = "TypeZone", values_from = c("part_ls_ind", "part_ls_coll")) %>%
59	3x	dplyr::mutate(
60	3x	ecart_part_indiv = .data$part_ls_ind_R - .data$part_ls_ind_F,
61	3x	dif_reg_fr_indiv_titre = dplyr::case_when(
62	3x	.data$ecart_part_indiv > 0 ~ "plus importante qu\u2019au",
63	3x	.data$ecart_part_indiv == 0 ~ "similaire au",
64	3x	.data$ecart_part_indiv < 0 ~ "moindre qu\u2019au"),
65	3x	dif_reg_fr_indiv_com = dplyr::case_when(
66	3x	.data$ecart_part_indiv > 0 ~ "cependant plus importante qu\u2019au",
67	3x	.data$ecart_part_indiv == 0 ~ "similaire au",
68	3x	.data$ecart_part_indiv < 0 ~ "m\u00eame moindre qu\u2019au"),
69	3x	com_part_ind_fr = dplyr::case_when(
70	3x	.data$ecart_part_indiv == 0 ~ "",
71	3x	TRUE ~ .data$part_ls_ind_F %>% format_fr_pct() %>% paste0(" (", ., ")")))
72
73		# commentaire 1er § nature bailleurs
74	3x	type_bail <- ligne_reg %>%
75	3x	tidyr::pivot_longer(cols = starts_with("partLs_"), values_to = "part_type_bail", names_to = "type_bail_maj") %>%
76	3x	dplyr::filter(.data$part_type_bail == max(.data$part_type_bail)) %>%
77	3x	dplyr::select("type_bail_maj", "part_type_bail") %>%
78	3x	dplyr::mutate(
79	3x	type_bail_maj = dplyr::case_when(
80	3x	.data$type_bail_maj == "partLs_oph" ~ "organismes publics pour l\u2019habitat (OPH)",
81	3x	.data$type_bail_maj == "partLs_esh" ~ "entreprises sociales de l\u2019habitat (ESH)",
82	3x	.data$type_bail_maj == "partLs_sem" ~ "soci\u00e9t\u00e9 d\u2019\u00e9conomie mixte (SEM)",
83	3x	TRUE ~ "indefini - categorie autre"))
84
85		# 3e § lgt etudiants - /!\ pas les DOM, ou FRPROV n'est pas dans le jeu d'indicteur
86	3x	nb_ls_etu <- amorce %>%
87	3x	dplyr::mutate(a_garder = dplyr::case_when(
88	3x	.data$TypeZone == "R" ~ TRUE,
89	3x	id_reg == "11" & .data$CodeZone == "FRMETRO" ~ TRUE,
90	3x	id_reg != "11" & .data$CodeZone == "FRPROV" ~ TRUE,
91	3x	TRUE ~ FALSE
92		)) %>%
93	3x	dplyr::filter(.data$a_garder) %>%
94	3x	dplyr::mutate(france_concernee = if_else(id_reg == "11", "France m\u00e9tropolitaine", "France de province")) %>%
95	3x	tidyr::pivot_wider(id_cols = "france_concernee", names_from = "TypeZone", values_from = c("nb_ls_etu" ,"part_ls_etu")) %>%
96	3x	dplyr::mutate(dplyr::across(dplyr::starts_with("nb_"), ~format_fr_nb(.x, dec = 0)),
97	3x	dplyr::across(dplyr::starts_with("part"), format_fr_pct))
98
99		# commentaire 5e §
100	3x	nb_pieces <- ligne_reg %>%
101	3x	dplyr::mutate(hausse_indiv_recent = (.data$part_ls_ind_recent > .data$part_ls_ind),
102	3x	baisse_5p_recent = (.data$part_5_pieces_et_plus - .data$part_5_pieces_et_plus_recent ) >= 0) %>%
103	3x	dplyr::select(dplyr::contains("hausse"), dplyr::contains("baisse"))
104
105		# mise en forme des valeurs
106	3x	ligne_reg <- ligne_reg %>%
107	3x	dplyr::mutate(dplyr::across(dplyr::starts_with("nb_"), ~format_fr_nb(.x, dec = 0)),
108	3x	dplyr::across(dplyr::starts_with("part"), format_fr_pct))
109
110		# on récupère les formulations idiomatiques grâce à {propre.datareg}
111	3x	verb_reg <- propre.datareg::datareg(code_reg = id_reg)
112
113		# on cree ensuite une liste nommee des differents parametres
114	3x	verb2 <- list(#titre
115	3x	dif_reg_fr_indiv_titre = indiv_coll$dif_reg_fr_indiv_titre,
116		# 1er §
117	3x	nom_reg = verb_reg$en_nom_region,
118	3x	max_part_bail = format_fr_pct(type_bail$part_type_bail),
119	3x	type_bail_maj = type_bail$type_bail_maj,
120		# 2e §
121	3x	nb_ls_actif = ligne_reg$nb_ls_actif,
122	3x	millesime = ligne_reg$millesime,
123	3x	nb_ls_loue = ligne_reg$nb_ls_loue,
124	3x	nb_ls_vacant = ligne_reg$nb_ls_vacant,
125	3x	nb_ls_hors_marche = ligne_reg$nb_ls_hors_marche,
126	3x	part_ls_hors_marche = ligne_reg$part_ls_hors_marche,
127	3x	nom_reg_2 = verb_reg$de_la_region,
128		# 3e §
129	3x	france_concernee = nb_ls_etu$france_concernee,
130	3x	nb_ls_etu_R = nb_ls_etu$nb_ls_etu_R,
131	3x	part_ls_etu_R = nb_ls_etu$part_ls_etu_R,
132	3x	part_ls_etu_F = nb_ls_etu$part_ls_etu_F,
133		# 4e §
134	3x	part_ls_coll_reg = indiv_coll$part_ls_coll_R %>% format_fr_pct(),
135	3x	part_ls_ind_reg = indiv_coll$part_ls_ind_R %>% format_fr_pct(),
136	3x	dif_reg_fr_indiv_com = indiv_coll$dif_reg_fr_indiv_com,
137	3x	com_part_ind_fr = indiv_coll$com_part_ind_fr,
138		# 5e §
139	3x	annee_mes_recent = annee - 5,
140	3x	part_1_2p_reg_recent = ligne_reg$part_1_2_pieces_recent,
141	3x	part_1_2p_reg = ligne_reg$part_1_2_pieces,
142	3x	hausse_indiv_recent = nb_pieces$hausse_indiv_recent,
143	3x	baisse_5p_recent = nb_pieces$baisse_5p_recent,
144	3x	part_ls_ind_recent = ligne_reg$part_ls_ind_recent,
145	3x	part_5_pieces_et_plus_recent = ligne_reg$part_5_pieces_et_plus_recent,
146	3x	part_5_pieces_et_plus = ligne_reg$part_5_pieces_et_plus
147		)
148
149		# production du verbatim a partir des elements precedents
150	3x	verbatim_chap_2 <- list()
151
152	3x	verbatim_chap_2$intertitre <- glue::glue("Une part de logements individuels {verb2$dif_reg_fr_indiv_titre} niveau national")
153
154		#1er paragraphe bailleur
155	3x	paragr1 <- glue::glue("{verb2$max_part_bail} du parc locatif social {verb2$nom_reg} appartient aux {verb2$type_bail_maj}. ")
156
157		#§ marché location
158	3x	paragr2 <- glue::glue("Sur les {verb2$nb_ls_actif} logements actifs au 1er janvier {verb2$millesime} de la r\u00e9gion,
159	3x	{verb2$nb_ls_loue} sont lou\u00e9s avec un contrat de location et {verb2$nb_ls_vacant}
160	3x	sont vacants. {verb2$nb_ls_hors_marche} logements se trouvent hors du march\u00e9 de la location, ce qui
161	3x	repr\u00e9sente {verb2$part_ls_hors_marche} du parc total {verb2$nom_reg_2}. \n\n")
162		#§ logement étudiant
163	3x	if (!(id_reg %in% paste0("0", 1:6))) { #pour éviter que la phrase apparaisse pour les DROM
164	3x	paragr3 <- glue::glue("Les {verb2$nb_ls_etu_R} logements \u00e9tudiants repr\u00e9sentent {verb2$part_ls_etu_R} du parc social ",
165	3x	"{verb2$nom_reg} contre {verb2$part_ls_etu_F} en {verb2$france_concernee}. \n\n")
166		} else {
167	!	paragr3 <- ""
168		}
169
170		#§ logement ind/coll
171	3x	paragr4 <- glue::glue("Dans la r\u00e9gion, les logements collectifs constituent la majorit\u00e9 du parc social
172	3x	({verb2$part_ls_coll_reg}). La part des logements individuels ({verb2$part_ls_ind_reg}) est
173	3x	{verb2$dif_reg_fr_indiv_com} niveau national{verb2$com_part_ind_fr}. \n\n")
174
175		#§ parc recent
176	3x	paragr5 <- glue::glue("Dans le parc r\u00e9cent, c\u2019est-\u00e0-dire mis en service depuis le 1er janvier {verb2$annee_mes_recent}, ")
177
178	3x	if(verb2$hausse_indiv_recent){
179	!	paragr5 <- glue::glue(paragr5, "les logements individuels sont proportionnellement plus nombreux
180	!	({verb2$part_ls_ind_recent}) que dans l\u0027ensemble du parc social ({verb2$part_ls_ind_reg}). L")
181		} else {
182	3x	paragr5 <- glue::glue(paragr5, "l")
183		}
184
185	3x	paragr5 <- glue::glue(paragr5, "es 1 ou 2 pi\u00e8ces repr\u00e9sentent {verb2$part_1_2p_reg_recent} des logements contre
186	3x	{verb2$part_1_2p_reg} dans le parc total. ")
187
188	3x	if(verb2$baisse_5p_recent) {
189	3x	paragr5 <- glue::glue(paragr5, "Seulement {verb2$part_5_pieces_et_plus_recent} des logements du parc r\u00e9cent ont 5 pi\u00e8ces ou plus ({verb2$part_5_pieces_et_plus} dans le parc total). ")
190		}
191
192	3x	verbatim_chap_2$commentaires <- glue::glue("{paragr1}\n\n{paragr2}\n\n{paragr3}\n\n{paragr4}\n\n{paragr5}")
193
194	3x	verbatim_chap_2
195		}

1		#' Selection des epci mis en avant dans la publication
2		#'
3		#' @description Selection des EPCI pour lesquels on aura un détail dans les tableaux et graphiques de la publication.
4		#'
5		#' @param nom_reg Le nom de la region au format texte.
6		#' @param choix_epci Le parametre utilisateur de détail par epci au format texte : "1- Tous les EPCI de la zone" ou "2- Liste d EPCI à saisir".
7		#' @param epci_list Le cas echeant, le vecteur des codes epci de reference, définis dans les parametres.
8		#'
9		#' @return Un vecteur de codes EPCI.
10		#' @importFrom dplyr pull intersect filter
11		#' @importFrom tidyr unnest
12		#' @importFrom attempt message_if_not
13		#' @export
14		#'
15		#' @examples
16		#' select_epci(nom_reg = "Bretagne", choix_epci = "1- Tous les EPCI de la zone", epci_list = NULL)
17		#' select_epci(
18		#' nom_reg = "Pays de la Loire", choix_epci = "2- Liste d EPCI à saisir",
19		#' epci_list = c("244400404", "244400644")
20		#' )
21		select_epci <- function(nom_reg = "Bretagne", choix_epci = "1- Tous les EPCI de la zone",
22		epci_list = NULL) {
23	6x	reg <- get_id_reg(nom_reg)
24
25	6x	epci_choisis <- COGiter::liste_zone %>%
26	6x	tidyr::unnest("REG") %>%
27	6x	dplyr::filter(.data$TypeZone == "Epci", .data$REG == reg) %>%
28	6x	dplyr::pull("CodeZone") %>%
29	6x	as.character()
30
31	6x	if (grepl("2-", choix_epci)) {
32	2x	epci_choisis <- dplyr::intersect(epci_list, epci_choisis)
33	2x	attempt::message_if_not(
34	2x	.x = length(epci_choisis) == length(epci_list), .p = isTRUE,
35	2x	msg = paste0("les EPCI saisis ne sont tous pas dans la region ", nom_reg)
36		)
37		}
38
39	6x	if (grepl("3-", choix_epci)) {
40	1x	epci_choisis <- NULL
41		}
42	6x	epci_choisis
43		}
44
45		# to do mieux traiter les facteurs

1		#' Creation du 2e graphique du chapitre Loyers et financements, representant le loyer moyen pour le parc total et le parc recent de la region selon le mode de financement
2		#'
3		#' @description Mise en page du diagramme en bâtons représentant le loyer moyen selon le mode de financement, pour le parc total et le parc récent.
4		#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref.
5		#' @param annee Le millésime renseigné par l'utilisateur, au format numérique.
6		#' @param palette choix de la palette de couleur parmi celle de \code{gouvdown::\link{scale_color_gouv_discrete}}
7		#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Loyer moyen des logements sociaux selon le type de financement au 01/01/{annee}")
8		#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
9		#'
10		#' @return Une liste de 3 objets : Un ggplot intéractif au format html (viz),
11		#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
12		#'
13		#' @importFrom dplyr filter select starts_with contains mutate
14		#' @importFrom forcats fct_relevel
15		#' @importFrom ggiraph geom_bar_interactive ggiraph
16		#' @importFrom ggplot2 ggplot aes position_dodge scale_x_discrete scale_y_continuous theme element_blank labs
17		#' @importFrom glue glue
18		#' @importFrom gouvdown scale_fill_gouv_discrete
19		#' @importFrom rlang .data
20		#' @importFrom tidyr pivot_longer pivot_wider
21		#' @export
22		#'
23		#' @examples
24		#' indicateurs_rpls_illustrations <- lire_rpls_exemple() %>%
25		#' dplyr::filter(Zone_ref)
26		#'
27		#' creer_graphe_6_2(data = indicateurs_rpls_illustrations, annee = 2020, note_de_lecture = "")[["viz"]]
28
29		creer_graphe_6_2 <- function(data, annee, palette = "pal_gouv_qual2",
30		titre = NULL,
31		note_de_lecture = "") {
32
33	1x	if (is.null(titre)){
34	1x	titre <- "Loyer moyen des logements sociaux \nselon le type de financement au 01/01/{annee}"
35		}
36
37		# une variable pour recuperer l'identifiant de la région choisie
38	1x	id_reg <- dplyr::filter(data, .data$Zone_ref, grepl("gion", .data$TypeZone)) %>%
39	1x	dplyr::pull("CodeZone") %>% unique() %>% as.character
40
41		# un booleen pour determiner si la region choisie est metropolitaine ou non
42	1x	metro <- !(id_reg %in% paste0("0", 1:6))
43		# Un vecteur de noms des financements qui s'adapte au contexte metropolitain ou DROM
44	1x	if(metro) {
45	1x	etiquette_financements <- c("PLUS", "PLAI", "PLS", "PLI", "Total")
46		} else {
47	!	etiquette_financements <- c("LLS", "LLTS", "PLS", "PLI", "Total")
48		}
49
50	1x	creer_graphe_6_2 <- data %>%
51		# filtre sur la région et pour le millesime souhaite
52	1x	dplyr::filter(.data$TypeZone == "R\u00e9gions" & .data$millesime == annee) %>%
53		# selection des variables necessaires au graphe
54	1x	dplyr::select("Zone", dplyr::starts_with("somme"), -dplyr::contains(c("_mes", "_age_", "_enqpv")),
55	1x	-"somme_loyer", -"somme_surface", -"somme_loyer_recent", -"somme_surface_recent") %>%
56		# passage au format long de la table en distinguant le financement du type de logement (recent ou pas)
57	1x	tidyr::pivot_longer(
58	1x	cols = -"Zone", names_to = c("variable", "financement", "type"), values_to = "values",
59	1x	names_pattern = "(loyer\|surface)[_]nb_(plus\|plai\|pls\|pli)[_]{0,1}(.*)"
60		) %>%
61	1x	tidyr::pivot_wider(names_from = "variable", values_from = "values") %>%
62		# creation de la modalite parc total
63	1x	dplyr::mutate(type = ifelse(.data$type == "", "total", .data$type),
64	1x	facette = "Par type de financement")
65
66
67	1x	creer_graphe_6_2 <- dplyr::bind_rows(creer_graphe_6_2,
68		#calcul des loyers et surfaces totaux "Tous types de financements"
69	1x	creer_graphe_6_2 %>%
70	1x	dplyr::group_by(.data$Zone, .data$type) %>%
71	1x	dplyr::summarise(loyer = sum(.data$loyer,na.rm = TRUE), surface = sum(.data$surface, na.rm = TRUE), .groups = "drop") %>%
72	1x	dplyr::mutate(facette = "Tous types de financements",
73	1x	financement = "Total")) %>%
74	1x	dplyr::mutate(loyer_moyen = .data$loyer/.data$surface,
75	1x	financement = forcats::fct_relevel(.data$financement,"plus","plai","pls","pli","Total"),
76	1x	facette = as.factor(.data$facette))
77
78	1x	g_bar <- ggplot2::ggplot(data = creer_graphe_6_2,
79	1x	ggplot2::aes(x = .data$financement, y = .data$loyer_moyen,
80	1x	fill = forcats::fct_relevel(.data$type, "total", "recent"),
81		# information a faire apparaitre dans les bulles: le nb_ls avec separateur des milliers
82	1x	tooltip = format_fr_nb(.data$loyer_moyen)
83		)) +
84		# geom_bar en version interactif
85	1x	ggiraph::geom_bar_interactive(stat = "identity", position = ggplot2::position_dodge()) +
86		# gestion des libelles de l axe des abscisses
87	1x	ggplot2::scale_x_discrete(
88	1x	breaks = c("plus", "plai", "pls", "pli", "Total"),
89	1x	labels = etiquette_financements
90		) +
91		# gestion des libelles de la legende
92	1x	gouvdown::scale_fill_gouv_discrete(palette = palette, breaks = c("total", "recent"),
93	1x	labels = c("Parc total", "Parc r\u00e9cent (5 ans ou moins)")) +
94		# formatage de l axe des ordonnees
95	1x	ggplot2::scale_y_continuous(labels = function(x) format_fr_nb(x, dec = 0),
96	1x	breaks = seq(0, max(dplyr::pull(creer_graphe_6_2, .data$loyer_moyen), na.rm = TRUE) + 1, 2)) +
97	1x	ggplot2::theme(
98		#suppression des labellers du facette
99	1x	strip.background = ggplot2::element_blank(),
100	1x	strip.text.x = ggplot2::element_blank(),
101	1x	legend.title = ggplot2::element_blank(),
102	1x	legend.position = "bottom"
103		) +
104		# habillage simple
105	1x	ggplot2::labs(
106	1x	title = glue::glue(titre),
107	1x	subtitle = "Unit\u00e9 : \u20ac/m\u00b2 de surface habitable",
108	1x	x = "",
109	1x	y = "",
110	1x	caption = dplyr::if_else(note_de_lecture != "" ,
111	1x	paste0(note_de_lecture, "\n\n", caption(sources = 1, mil_rpls = annee)),
112	1x	caption(sources = 1, mil_rpls = annee))) +
113	1x	ggplot2::facet_grid(~.data$facette,scales="free", space="free_x")
114		# transformation par ggiraph
115	1x	graphe <- ggiraph::ggiraph(code = print(g_bar))
116
117		# donnees a faire figurer dans l'export xls
118	1x	data_xls <- dplyr::select(creer_graphe_6_2 , -c("loyer", "surface", "facette"))
119
120		# metadonnees a faire figurer dans la table des matiere de l'export xls
121	1x	index <- data.frame(onglet = "graphe_6_2", titre = glue::glue(titre) %>% gsub("\n", " ", .))
122
123	1x	return(list(viz = graphe, tab_xls = data_xls, meta = index))
124
125
126		}

1		#' Mentions legales : Verbatim
2		#'
3		#' @description Production des commentaires verbatim des mentions légales.
4		#'
5		#' @param date_publication La date de publication. Par défaut la date du jour, pour personnaliser, utiliser le format JJ/MM/AAAA.
6		#' @param nom_reg Le nom de la region au format texte, tel qu'issu de la saisie utilisateur, par exemple '01 Guadeloupe'.
7		#'
8		#' @return Un vecteur de 11 chaînes de caractères comprenant la date de publication, les informations relatives au service gestionnaire,
9		#' à la direction de publication, au développement, à l'issn, à l'hébergement, aux droits d'auteur, aux codes sources, à la création de liens,
10		#' aux usages et au traitements des données personnelles.
11		#'
12		#' @importFrom glue glue
13		#' @importFrom lubridate today ymd
14		#' @importFrom propre.datareg datareg
15		#' @importFrom rlang .data
16		#' @importFrom stringr str_sub
17		#'
18		#' @export
19		#'
20		#' @examples
21		#' creer_verbatim_mentions_legales(nom_reg = "Bretagne")
22
23		creer_verbatim_mentions_legales <- function(date_publication = lubridate::today(), nom_reg = "Bretagne") {
24
25		# Formatage de la date
26	12x	if(date_publication == lubridate::today()){
27	12x	date_publication <- format(lubridate::ymd(date_publication), format = "%d %B %Y")
28		} else {
29		# On part du principe que l utilisateur remplira une date sous format jj/mm/aaaa
30	!	date_publication <- format(lubridate::ymd(paste0(stringr::str_sub(date_publication, 7, 10),
31	!	stringr::str_sub(date_publication, 4, 5),
32	!	stringr::str_sub(date_publication, 1, 2))), format = "%d %B %Y")
33		}
34
35		# Récupération du code région et des donnees regionales de mentions legales
36	12x	id_reg <- get_id_reg(nom_reg)
37	12x	mentions_reg <- propre.datareg::datareg(code_reg = id_reg)
38
39		# Création de la liste avec les parties des mentions légales contenant des éléments à paramétrer
40	12x	verbatim_mentions_legales <- list(date = "", service_gestionnaire = "", direction_publication = "", developpement ="",
41	12x	issn = "", hebergement = "", droit_auteur = "", code_source = "", lien = "",
42	12x	usage = "", donnees_perso = "")
43
44		# Paramétrage de la date de publication
45	12x	verbatim_mentions_legales$date <- glue::glue("Publi\u00e9 le {date_publication}")
46
47		# Paramétrage des infos relatives au service gestionnaire
48	12x	verbatim_mentions_legales$service_gestionnaire <- glue::glue("{mentions_reg$nom_dreal}\n
49	12x	{mentions_reg$adresse}\n
50	12x	T\u00e9l\u00e9phone : {mentions_reg$telephone}\n
51	12x	Courriel : {mentions_reg$courriel_contact}")
52
53		# Paramétrage des infos relatives à la direction de publication
54	12x	verbatim_mentions_legales$direction_publication <- glue::glue("{mentions_reg$prenom_directeur_directrice} {mentions_reg$nom_directeur_directrice}, {mentions_reg$titre}.")
55
56		# Paramétrage des infos relatives au développement
57	12x	verbatim_mentions_legales$developpement <- "- Cl\u00e9ment Belliard\n- Fabio Dos Santos Pereira\n- Juliette Engelaere-Lefebvre\n- Franck Gaspard\n- Daniel Kalioudjoglou\n- Murielle Lethrosne\n- Jean-Bernard Salomond\n- Mael Theuli\u00e8re\n- Arnaud Wilczynski\n- Marouane Zellou"
58
59		# Paramétrage des infos relatives à l'ISSN
60	12x	verbatim_mentions_legales$issn <- "En cours"
61
62		# Paramétrage des infos relatives à l'hébergement
63	12x	verbatim_mentions_legales$hebergement <- "http://dreal.statistiques.developpement-durable.gouv.fr/"
64
65		# Paramétrage du texte sur le droit d'auteur
66	12x	verbatim_mentions_legales$droit_auteur <- glue::glue("Tous les contenus pr\u00e9sents sur ce site sont couverts par le droit d\'auteur.
67	12x	Toute reprise est d\u00e8s lors conditionn\u00e9e \u00e0 l\'accord de l\'auteur en vertu de l\'article
68	12x	L.122-4 du Code de la Propri\u00e9t\u00e9 Intellectuelle.\n
69	12x	Toutes les informations li\u00e9es \u00e0 cette publication (donn\u00e9es et textes) sont publi\u00e9es sous licence ouverte/open licence v2
70	12x	(dite licence Etalab) : quiconque est libre de r\u00e9utiliser ces informations sous r\u00e9serve, notamment, d\'en mentionner la filiation.\n
71	12x	Tous les scripts sources du package sont disponibles sous licence [GPL-3.0-or-later](https://spdx.org/licenses/GPL-3.0-or-later.html). \n
72	12x	La [charte graphique de la marque d'\u00c9tat](https://www.gouvernement.fr/charte/charte-graphique-les-fondamentaux/la-typographie)
73	12x	est \u00e0 usage exclusif des acteurs de la sphe\u0300re e\u0301tatique.
74	12x	En particulier, la typographie Marianne\u00a9 est prot\u00e9g\u00e9e par le droit d'auteur.")
75
76		# Paramétrage des infos relatives aux codes sources
77	12x	verbatim_mentions_legales$code_source <- "L\u2019ensemble des scripts de collecte et de datavisualisation est disponible
78	12x	sur le r\u00e9pertoire gitlab du r\u00e9seau des statisticiens en DREAL (https://gitlab.com/rdes_dreal/propre.rpls).
79	12x	Vous pouvez y reporter les \u00e9ventuels bugs ou demandes d'\u00e9volution au niveau de la rubrique _Issues_."
80
81		# Paramétrage des infos relatives aux liens
82	12x	verbatim_mentions_legales$lien <- "Tout site public ou priv\u00e9 est autoris\u00e9 \u00e0 \u00e9tablir, sans autorisation pr\u00e9alable,
83	12x	un lien vers les informations diffus\u00e9es par le Minist\u00e8re de la Transition \u00c9cologique et de la Coh\u00e9sion des Territoires.\n
84	12x	L\u2019autorisation de mise en place d\'un lien est valable pour tout support, \u00e0 l\'exception de ceux diffusant des informations
85	12x	\u00e0 caract\u00e8re pol\u00e9mique, pornographique, x\u00e9nophobe ou pouvant, dans une plus large mesure porter atteinte
86	12x	\u00e0 la sensibilit\u00e9 du plus grand nombre.\n
87	12x	Pour ce faire, et toujours dans le respect des droits de leurs auteurs, une ic\u00f4ne Marianne est disponible
88	12x	sur le site https://www.gouvernement.fr/marque-Etat pour agr\u00e9menter votre lien et pr\u00e9ciser que le site d\'origine
89	12x	est celui du Minist\u00e8re de la Transition \u00c9cologique et de la Coh\u00e9sion des Territoires."
90
91		# Paramétrage du texte sur les usages
92	12x	verbatim_mentions_legales$usage <- glue::glue("Les utilisateurs sont responsables des interrogations qu\'ils formulent ainsi que de
93	12x	l\'interpr\u00e9tation et de l\'utilisation qu\'ils font des r\u00e9sultats.
94	12x	Il leur appartient d\'en faire un usage conforme aux r\u00e9glementations en vigueur et aux recommandations de la CNIL
95	12x	lorsque des donn\u00e9es ont un caract\u00e8re nominatif (loi n\u00b0 78.17 du 6 janvier 1978, relative \u00e0 l\'informatique,
96	12x	aux fichiers et aux libert\u00e9s dite loi informatique et libert\u00e9s).\n
97	12x	Il appartient \u00e0 l\'utilisateur de ce site de prendre toutes les mesures appropri\u00e9es de fa\u00e7on \u00e0 prot\u00e9ger
98	12x	ses propres donn\u00e9es et/ou logiciels de la contamination par d\'\u00e9ventuels virus circulant sur le r\u00e9seau Internet.
99	12x	De mani\u00e8re g\u00e9n\u00e9rale, la {mentions_reg$nom_dreal} d\u00e9cline toute responsabilit\u00e9 quant \u00e0 un \u00e9ventuel
100	12x	dommage survenu pendant la consultation du pr\u00e9sent site.
101	12x	Les messages que vous pouvez nous adresser transitant par un r\u00e9seau ouvert de t\u00e9l\u00e9communications,
102	12x	nous ne pouvons assurer leur confidentialit\u00e9.")
103
104		# Paramétrage des infos relatives au traitement des données personnelles
105	12x	verbatim_mentions_legales$donnees_perso <- "L\u2019outil ne fait pas d\'usage interne de donn\u00e9es \u00e0 caract\u00e8re personnel."
106
107		# Affichage du résultat
108	12x	verbatim_mentions_legales
109
110		}

1		#' fonction utilitaire de formatage en pourcentage pour le francais
2		#'
3		#' @description fonction utilitaire de formatage en pourcentage pour le francais
4
5		#' @param x un nombre à formater en pourcentage
6		#' @param dec un entier désignant le nombre de chiffres après la virgule souhaité (1 par défaut)
7		#'
8		#' @return une chaîne de texte, x %, avec transformation de la décimale en virgule et insertion d'un espace insécable
9		#'
10		#' @importFrom attempt stop_if_not
11		#'
12		#' @export
13		#'
14		#' @examples
15		#' format_fr_pct(100/3)
16		#'
17
18		#' @importFrom attempt stop_if_not
19		format_fr_pct <- function(x, dec = 1) {
20	159x	attempt::stop_if_not(x, is.numeric, msg = "x n'est pas un nombre, revoyez la saisie de l'argument de format_fr_pct(x, dec)")
21	158x	paste0(formatC(x, decimal.mark = ",", big.mark = "\u202f", format = "f", digits = dec), "\u00a0%")
22		}
23
24		#' fonction utilitaire de formatage de nombre pour le francais
25		#'
26		#' @description fonction utilitaire de formatage de nombre pour le francais
27
28		#' @param x un nombre à formater en français
29		#' @param dec un entier désignant le nombre de chiffres après la virgule souhaité (1 par défaut)
30		#' @param big_mark le séparateur des milliers
31		#' @return une chaîne de texte avec transformation de la décimale en virgule et insertion d'un caractère spécifié via big_mark au niveau du séparateur de milliers
32		#'
33		#' @importFrom attempt stop_if_not
34		#'
35		#' @export
36		#'
37		#' @examples
38		#' format_fr_nb(10000000/7)
39
40		#' @importFrom attempt stop_if_not
41		format_fr_nb <- function(x, dec = 1, big_mark) {
42	164x	attempt::stop_if_not(x, is.numeric, msg = "x n'est pas un nombre, revoyez la saisie de l'argument de format_fr_nb(x, dec)")
43
44	126x	if(missing("big_mark")) {big_mark <- "\u202f"}
45	163x	paste0(formatC(x, decimal.mark = ",", format = "f", digits = dec, big.mark = big_mark))
46		}
47
48		#' normalisation d'une chaine de texte
49		#'
50		#' str_standardize enleve les accents, les espaces et les caracteres speciaux d'une chaine de texte.
51		#' Cette fonction provient du package {tricky} de Paul-Antoine Chevalier (https://github.com/pachevalier/tricky), merci à lui !
52		#'
53		#' Voir http://stackoverflow.com/a/36898175/1967500 pour enlever les accents
54		#'
55		#' @param string une chaine de texte a normaliser
56		#' @param prefix la chaine de texte a ajouter en prefixe au besoin (seulement devant des chiffres, c'est utile en cas de renommage de variables)
57		#' @source https://github.com/pachevalier/tricky/blob/master/R/strings.R
58		#'
59		#' @return une chaine de texte normalisee
60		#' @export
61		#'
62		#' @examples
63		#' str_standardize("2017/07/07", prefix = "date_")
64		#' str_standardize("code externe de l'action")
65		#'
66		#' @importFrom stringi stri_trans_general
67		#' @importFrom stringr str_trim str_to_lower str_replace_all str_replace
68		#'
69		str_standardize <- function(string, prefix = "") {
70	3x	string %>%
71	3x	stringr::str_trim(side = "both") %>%
72	3x	stringr::str_to_lower() %>%
73	3x	stringi::stri_trans_general(
74	3x	id = "Latin-ASCII"
75		) %>%
76	3x	stringr::str_replace_all(
77	3x	pattern = "[[:blank:][:punct:]\n]+",
78	3x	replacement = "_"
79		) %>%
80	3x	stringr::str_replace_all(
81	3x	pattern = "[\\[\\]\\(\\)]",
82	3x	replacement = ""
83		) %>%
84	3x	stringr::str_replace(
85	3x	pattern = "^([[:digit:]].*)",
86	3x	replacement = paste0(prefix, "\\1")
87		)
88		}
89
90		#' Incrementation de l'export xls
91		#'
92		#' incrementer_export_xls sert a incrementer la table des matiere et a ajouter un onglet dans le tableur d'export xls des donnees visualisees.
93		#'
94		#' @param visuel_cree la liste de 3 objets (viz, meta, et tab_xls) resultat de la fonction d'illustration propre.rpls
95		#' @param list_xls nom de l'objet de type liste qui rassemble les informations des differentes illustrations a exporter vers excel, a creer en debut de book
96		#' @param ongl_index nom de l'onglet de la table des matieres (1er composant de la liste `list_xls`)
97		#'
98		#'
99		#' @return l'objet de type liste qui rassemble les informations a exporter vers excel, enrichi des informations relatives au visuel `visuel_cree`
100		#' (nouvel onglet et nouvelle ligne dans la table des matieres)
101		#' @export
102		#' @importFrom attempt stop_if_not
103		#' @importFrom dplyr bind_rows
104		#'
105		#' @examples
106		#' tab_1_1 <- creer_tableau_1_1(data = lire_rpls_exemple() %>% dplyr::filter(Zone_ref), annee = 2022)
107		#' incrementer_export_xls(tab_1_1)
108
109
110		incrementer_export_xls <- function(visuel_cree, list_xls = list(), ongl_index = "index"){
111
112		# Verification de la validité des arguments
113	1x	attempt::stop_if_not(.x = list_xls, .p = is.list,
114	1x	msg = "l'argument list_xls renseigne n'est pas de type list ou n'existe pas, revoyez votre saisie")
115	1x	attempt::stop_if_not(.x = visuel_cree, .p = ~ is.list(.x) & length(.x) == 3,
116	1x	msg = "l'argument visuel_cree renseigne ne correspond pas au resultat d'une fonction de creation d'illustration de propre.rpls, revoyez votre saisie")
117
118		# Recuperartion du contenu initial de la liste list_xls
119	1x	export_enrichi <- list_xls
120
121		# Incrementation de la table des matiere
122		# - pour le 1er visuel, la table des matiere n'est pas amorcee
123	1x	if(is.null(list_xls[[ongl_index]])) {
124	!	export_enrichi[[ongl_index]] <- data.frame(onglet = character(), titre = character())
125		}
126		# - on ajoute la ligne dans la table des matiere pre-existante si la creation de viz renvoie qqch
127	1x	if(!is.null(visuel_cree[["meta"]])) {
128	1x	export_enrichi[[ongl_index]] <- dplyr::bind_rows(export_enrichi[[ongl_index]], visuel_cree[["meta"]])
129		}
130
131		# on stocke les donnees du visuel dans un nouvel onglet de l'export xls
132	1x	if(!is.null(visuel_cree[["tab_xls"]])) {
133	1x	export_enrichi[[visuel_cree[["meta"]]$onglet]] <- visuel_cree[["tab_xls"]]
134		}
135	1x	return(export_enrichi)
136		}
137
138
139		#' Visualisation d'une illustration.
140		#'
141		#' Visualisation d'une illustration html creee par une fonction de propre.rpls.
142		#'
143		#' @param visuel_cree la liste de 3 objets (viz, meta, et tab_xls) resultat de la fonction d'illustration propre.rpls
144		#'
145		#' @return une illustration au format html
146		#' @export
147		#'
148		#' @examples
149		#' tab_1_1 <- creer_tableau_1_1(data = lire_rpls_exemple() %>% dplyr::filter(Zone_ref), annee = 2022)
150		#' afficher_visuel(tab_1_1)
151		afficher_visuel <- function(visuel_cree) {
152	1x	visuel_cree$viz
153		}

1		#' Creation du 2e graphique du chapitre sur les mises en service et les sorties, representant les mises en services en et hors quartiers prioritaires de la politique de la ville.
2		#' @description Création du graphique en barres réprésentant le nombre de logements entrés dans le patrimoine des bailleurs selon
3		#' qu'ils sont situés ou non en zone QPV (quartier prioritaire de la ville)
4		#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref.
5		#' @param annee Une année parmi les millésimes sélectionnables par l'utilisateur, au format numérique.
6		#' @param palette choix de la palette de couleur parmi celle de \code{gouvdown::\link{scale_color_gouv_discrete}}
7		#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Logements mis en service en {annee-1} dans et hors quartiers prioritaires de la politique de la ville (QPV)")
8		#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
9		#'
10		#' @return Une liste de 3 objets : un graphique en barres interactif au format html (viz),
11		#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
12		#'
13		#' @importFrom dplyr filter select mutate case_when pull
14		#' @importFrom forcats fct_relevel fct_drop
15		#' @importFrom ggiraph geom_bar_interactive ggiraph
16		#' @importFrom ggplot2 ggplot aes labs
17		#' @importFrom gouvdown scale_fill_gouv_discrete
18		#' @importFrom stringr str_detect
19		#' @importFrom tidyr pivot_longer
20		#' @importFrom rlang .data
21		#' @importFrom glue glue
22		#'
23		#' @export
24		#'
25		#' @examples
26		#' indicateurs_rpls_illustrations <- lire_rpls_exemple() %>%
27		#' dplyr::filter(Zone_ref)
28		#'
29		#' creer_graphe_3_2(data = indicateurs_rpls_illustrations, annee = 2019, note_de_lecture = "")[["viz"]]
30
31
32		creer_graphe_3_2 <- function(data, annee, palette = "pal_gouv_div1",
33		titre = NULL,
34		note_de_lecture = ""){
35
36	1x	if (is.null(titre)){
37	1x	titre <- "Logements mis en service en {annee-1} dans et hors quartiers prioritaires de la politique de la ville (QPV)"}
38		# Création de la table utile à la production du graphique
39	1x	tab <- data %>%
40		# Filtres pour ne garder que les données de la région et du millésime sélectionné
41	1x	dplyr::filter(.data$TypeZone == "R\u00e9gions",
42	1x	.data$millesime == annee) %>%
43		# Sélection des variables utiles pour le graphique
44	1x	dplyr::select("TypeZone", "Zone", "millesime",
45	1x	"nb_mes_qpv_construit_org", "nb_mes_qpv_acq_av_travaux",
46	1x	"nb_mes_qpv_acq_ss_travaux", "nb_mes_qpv_acq_vefa",
47	1x	"nb_mes_nonqpv_construit_org", "nb_mes_nonqpv_acq_av_travaux",
48	1x	"nb_mes_nonqpv_acq_ss_travaux", "nb_mes_nonqpv_acq_vefa") %>%
49		# Passage du format large au format long
50	1x	tidyr::pivot_longer(-c("TypeZone", "Zone", "millesime"),
51	1x	values_to = "Nb_logements", names_to = c("Variable"),
52	1x	names_pattern = "nb_mes_?(.*)") %>%
53		# Création des deux variables relatives à QPV / hors QPV et à l'entrée dans le patrimoine
54	1x	dplyr::mutate(Zone_QPV = ifelse(stringr::str_detect(string = .data$Variable, pattern = "^qpv"), "En QPV", "Hors QPV"),
55	1x	Entree_patrimoine = dplyr::case_when(
56	1x	stringr::str_detect(string = .data$Variable, pattern = "construit_org") ~ "Construit par\nl\'organisme",
57	1x	stringr::str_detect(string = .data$Variable, pattern = "acq_av_travaux") ~ "Acquis avec\ntravaux",
58	1x	stringr::str_detect(string = .data$Variable, pattern = "acq_ss_travaux") ~ "Acquis sans\ntravaux",
59	1x	stringr::str_detect(string = .data$Variable, pattern = "acq_vefa") ~ "Acquis en\nVEFA"),
60	1x	Entree_patrimoine = as.factor(.data$Entree_patrimoine),
61	1x	Entree_patrimoine = forcats::fct_relevel(.data$Entree_patrimoine,
62	1x	"Construit par\nl\'organisme", "Acquis en\nVEFA",
63	1x	"Acquis avec\ntravaux", "Acquis sans\ntravaux"),
64		# Suppression des modalités de "millesime" non retenues
65	1x	millesime = forcats::fct_drop(millesime))
66
67
68		# Création du graphique
69	1x	graphe <- ggplot2::ggplot(data = tab, mapping = ggplot2::aes(x = .data$Entree_patrimoine, y = .data$Nb_logements,
70	1x	fill = .data$Zone_QPV)) +
71		# Création graphique en barres en mode interactif
72	1x	ggiraph::geom_bar_interactive(stat = "identity", data_id = row.names(tab),
73	1x	tooltip = format(dplyr::pull(tab, "Nb_logements"), big.mark = " ")) +
74		# Paramétrage titre, sous-titre, axes ...
75	1x	ggplot2::labs(title = stringr::str_wrap(glue::glue(titre),
76	1x	width = 55),
77	1x	subtitle = "Unit\u00e9 : nombre de logements",
78	1x	x = "",
79	1x	y = "",
80	1x	fill = "",
81	1x	caption = dplyr::if_else(note_de_lecture != "" ,
82	1x	paste0(note_de_lecture, "\n\n", caption(sources = 1, mil_rpls = annee)),
83	1x	caption(sources = 1, mil_rpls = annee))) +
84	1x	ggplot2::scale_y_continuous(labels = function(x) format(x, big.mark = " ")) +
85	1x	scale_fill_gouv_discrete(palette = palette)
86
87		# Ajout de l'interactivité
88	1x	graphe <- ggiraph::ggiraph(code = print(graphe))
89
90		# donnees a faire figurer dans l'export xls
91	1x	data_xls <- dplyr::select(tab , -"TypeZone", -"Variable") %>%
92	1x	dplyr::mutate(Entree_patrimoine = gsub("\n", "", .data$Entree_patrimoine))
93
94		# metadonnees a faire figurer dans la table des matieres de l'export xls
95	1x	index <- data.frame(onglet = "graphe_3_2", titre = glue::glue(titre))
96
97	1x	return(list(viz = graphe, tab_xls = data_xls, meta = index))
98
99		}

1		#' Creation de la 2e carte du chapitre sur la tension du parc, representant le taux de mobilite par EPCI.
2		#'
3		#' @description Création de la carte représentant le taux de mobilité par EPCI pour l'année N choisie.
4		#'
5		#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur.
6		#' @param annee Une année parmi les millésimes sélectionnables par l'utilisateur, au format numérique.
7		#' @param carto La table des fonds de carte realisee avec \code{mapfactory::\link{fond_carto}}.
8		#' @param bornes Les bornes manuelles.
9		#' @param palette choix de la palette de couleurs parmi celle de \code{gouvdown::\link{scale_color_gouv_discrete}}
10		#' @param inverse choix du sens de la progression des couleurs : du plus foncé au plus clair (FALSE) ou du plus clair au plus foncé (TRUE)
11		#' @param maille le maillage souhaite pour la carte, a choisir parmi "commune", "EPCI" ou "département". "EPCI" par defaut.
12		#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Taux de mobilité par {maille} en {annee-1}")
13		#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
14		#' @param na_label L'etiquette à afficher dans la legende pour les valeurs manquantes ("Valeurs manquantes" par défaut).
15		#' @param ... autres paramètres de la fonction[\code{mapfactory::creer_carte}](https://dreal-pdl.gitlab-pages.din.developpement-durable.gouv.fr/csd/mapfactory/reference/creer_carte.html).
16		#'
17		#' @return Une liste de 3 objets : une carte choroplethe mise en page au format html (viz),
18		#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
19		#'
20		#' @importFrom dplyr filter slice pull if_else select
21		#' @importFrom glue glue
22		#' @importFrom mapfactory creer_carte
23		#' @importFrom COGiter list_epci_in_reg list_com_in_reg
24		#' @export
25		#'
26		#' @examples
27		#' indicateurs_rpls <- lire_rpls_exemple()
28		#'
29		#' creer_carte_5_2(data = indicateurs_rpls,
30		#' annee = 2019,
31		#' carto = mapfactory::fond_carto("Corse"),
32		#' bornes = NULL,
33		#' note_de_lecture = "")[["viz"]]
34
35
36		creer_carte_5_2 <- function(data, annee, carto, bornes = NULL, palette = "pal_gouv_o", inverse = TRUE, maille = "EPCI",
37		titre = "Taux de mobilit\u00e9 par {maille} en {annee-1}",
38		note_de_lecture = "", na_label = "Valeurs manquantes", ...) {
39
40		# récupérer le code de la région à partir du jeu de données
41	1x	reg <- data %>%
42	1x	dplyr::filter(.data$TypeZone == "R\u00e9gions", .data$Zone_ref == TRUE) %>%
43	1x	dplyr::slice(1) %>%
44	1x	dplyr::pull("CodeZone") %>%
45	1x	as.character()
46
47		# preparer la table à visualiser
48	1x	data <- data %>%
49	1x	dplyr::filter(.data$millesime == annee)
50
51	1x	map <- mapfactory::creer_carte(data = data, code_region = reg, carto = carto, maillage = maille, indicateur = taux_mobilite,
52	1x	type_viz = "choroplethe", palette = palette, inverse = inverse, interactive = TRUE,
53	1x	titre = glue::glue(titre), decimales = 1,
54	1x	bas_de_page = dplyr::if_else(note_de_lecture != "" ,
55	1x	paste0(note_de_lecture, "\n\n", caption(sources = 1, mil_rpls = annee)),
56	1x	caption(sources = 1, mil_rpls = annee)),
57	1x	evolution = FALSE, suffixe = " %", na_label = na_label, bornes = bornes, ...)
58		# donnees a faire figurer dans l'export xls
59	1x	codes_zones_a_garder <- c(COGiter::list_epci_in_reg(reg), COGiter::list_com_in_reg(reg))
60	1x	data_xls <- data %>%
61		# filtre sur la region et la maille de la carte, attention les noms de mailles dans TypeZone sont légèrement différents du paramètre maille
62	1x	dplyr::filter(grepl(tolower(maille), tolower(.data$TypeZone)), .data$CodeZone %in% codes_zones_a_garder) %>%
63	1x	dplyr::select("CodeZone", "Zone", "taux_mobilite")
64
65		# metadonnees a faire figurer dans la table des matiere de l'export xls
66	1x	index <- data.frame(onglet = "carte_5_2", titre = glue::glue(titre))
67
68	1x	return(list(viz = map, tab_xls = data_xls, meta = index))
69
70		}

1		#' Creation du graphique du chapitre sur les evolutions du parc, representant l evolution en base 100 du nombre de logements sociaux ces 5 dernieres annees pour la region et deux territoires supra de comparaison.
2		#' @description Création du graphique représentant l'évolution en base 100 du nombre de logements sociaux sur 6 ans
3		#' (de 5 années avant l'année choisie jusqu'à l'année choisie).
4		#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref.
5		#' @param annee Une année parmi les millésimes sélectionnables par l'utilisateur, au format numérique.
6		#' @param palette choix de la palette de couleur parmi celle de \code{gouvdown::\link{scale_color_gouv_discrete}}
7		#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Évolution du nombre de logements sociaux")
8		#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
9		#'
10		#' @return Une liste de 3 objets : un graphique en courbes interactif au format html (viz),
11		#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
12		#'
13		#' @importFrom dplyr filter select group_by mutate first ungroup pull
14		#' @importFrom forcats fct_drop
15		#' @importFrom ggiraph geom_point_interactive ggiraph
16		#' @importFrom ggplot2 ggplot aes geom_line labs
17		#' @importFrom gouvdown scale_color_gouv_discrete
18		#' @importFrom rlang .data
19		#'
20		#' @export
21		#'
22		#' @examples
23		#' indicateurs_rpls_illustrations <- lire_rpls_exemple() %>%
24		#' dplyr::filter(Zone_ref)
25		#'
26		#' creer_graphe_1_1(data = indicateurs_rpls_illustrations, annee = 2019, note_de_lecture = "")[["viz"]]
27
28
29		creer_graphe_1_1 <- function(data, annee, palette = "pal_gouv_qual2", titre = "\u00c9volution du nombre de logements sociaux", note_de_lecture = ""){
30
31		# Création de la table utile à la production du graphique
32	1x	tab <- data %>%
33		# Filtres pour ne garder que les données de la région et du millésime sélectionné
34	1x	dplyr::filter(.data$TypeZone %in% c("R\u00e9gions", "France"),
35	1x	.data$millesime %in% annee:(annee-5)) %>%
36		# Sélection des variables utiles pour le graphique
37	1x	dplyr::select("TypeZone", "Zone", "millesime", "nb_ls_actif") %>%
38		# Regroupement des valeurs selon les modalités de la variable `Zone` pour calcul des valeurs en base 100
39	1x	dplyr::group_by(.data$Zone) %>%
40		# On s'assure que le dataset est ordonné correctement selon les années pour calcul des évolutions base 100
41	1x	dplyr::arrange(as.character(.data$millesime)) %>%
42		# Création d'une variable calculant l'évolution en base 100 (depuis 4 année avant l'annee choisie)
43	1x	dplyr::mutate(Evol_ls_B100 = 100*.data$nb_ls_actif / dplyr::first(.data$nb_ls_actif),
44		# Suppression des modalités de "millesime" non retenues
45	1x	millesime = forcats::fct_drop(.data$millesime)) %>%
46		# Dégroupement des groupes réalisés
47	1x	dplyr::ungroup()
48
49
50		# Création du graphique
51	1x	graphe <- ggplot2::ggplot(data = tab, mapping = ggplot2::aes(x = .data$millesime, y = .data$Evol_ls_B100)) +
52		# Traçage des courbes lignes (non animées)
53	1x	ggplot2::geom_line(mapping = ggplot2::aes(color = .data$Zone, group = .data$Zone)) +
54		# Traçage des points en interactif
55	1x	ggiraph::geom_point_interactive(mapping = ggplot2::aes(color = .data$Zone), size = 2, data_id = row.names(tab),
56	1x	tooltip = paste0("Nombre de logements sociaux : ",
57	1x	format(dplyr::pull(tab, "nb_ls_actif"), big.mark = " "))) +
58		# Paramétrage titre, sous-titre, axes ...
59	1x	ggplot2::labs(title = titre,
60	1x	subtitle = paste0("Base 100 au 01/01/",
61	1x	min(levels(dplyr::pull(tab, "millesime")))),
62	1x	x = "",
63	1x	y = "",
64	1x	caption = dplyr::if_else(note_de_lecture != "" ,
65	1x	paste0(note_de_lecture, "\n\n", caption(sources = 1, mil_rpls = annee)),
66	1x	caption(sources = 1, mil_rpls = annee))) +
67	1x	ggplot2::theme(legend.position = "bottom") +
68	1x	ggplot2::guides(color = ggplot2::guide_legend(title = "", nrow = 2, byrow = TRUE)) +
69	1x	gouvdown::scale_color_gouv_discrete(palette = palette) +
70	1x	ggplot2::scale_y_continuous(labels = ~format_fr_nb(x = .x, dec = 0))
71
72	1x	graphe <- ggiraph::ggiraph(code = print(graphe))
73
74		# donnees a faire figurer dans l'export xls
75	1x	data_xls <- dplyr::select(tab , -"TypeZone")
76
77		# metadonnees a faire figurer dans la table des matiere de l'export xls
78	1x	index <- data.frame(onglet = "graphe_1_1", titre = titre)
79
80	1x	return(list(viz = graphe, tab_xls = data_xls, meta = index))
81
82		}

1		#' Creation de la carte du chapitre sur les evolutions du parc, representant l evolution annuelle du nombre de logements sociaux par EPCI.
2		#'
3		#' @description Mise en page de la carte du chapitre 1 au format html, concernant l'évolution annuelle du nombre de logements sociaux.
4		#'
5		#' @param data La table préparée par dataprep() selon les inputs de l'utilisateur.
6		#' @param annee Le millésime renseigné par l'utilisateur.
7		#' @param carto La table des fonds de carte realisee avec \code{mapfactory::\link{fond_carto}}.
8		#' @param bornes Les bornes manuelles de la légende, mettre à NULL pour utiliser la méthode par défaut (quantile).
9		#' @param palette choix de la palette de couleur parmi celle de \code{gouvdown::\link{scale_color_gouv_discrete}}
10		#' @param inverse choix du sens de la progression des couleurs : du plus foncé au plus clair (FALSE) ou du plus clair au plus foncé (TRUE)
11		#' @param maille le maillage souhaite pour la carte, a choisir parmi "commune", "EPCI" ou "département". "EPCI" par defaut.
12		#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Évolution du nombre de logements sociaux par {maille}")
13		#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
14		#' @param na_label L'etiquette à afficher dans la legende pour les valeurs manquantes ("Valeurs manquantes" par défaut).
15		#' @param decimales Le nombre de decimales voulu pour les bornes de la legende (0 par defaut)
16		#' @param ... autres paramètres de la fonction [\code{mapfactory::creer_carte}](https://dreal-pdl.gitlab-pages.din.developpement-durable.gouv.fr/csd/mapfactory/reference/creer_carte.html).
17		#'
18		#' @return Une liste de 3 objets : une carte mise en page au format html (viz),
19		#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
20		#'
21		#' @importFrom dplyr filter slice pull if_else ends_with select
22		#' @importFrom COGiter list_epci_in_reg list_com_in_reg
23		#' @importFrom glue glue
24		#' @importFrom mapfactory creer_carte
25		#'
26		#' @export
27		#'
28		#' @examples
29		#' indicateurs_rpls <- lire_rpls_exemple()
30		#' creer_carte_1_1(
31		#' data = indicateurs_rpls,
32		#' carto = mapfactory::fond_carto("Corse"),
33		#' annee = 2019,
34		#' bornes = c(0.1, 10, 30),
35		#' note_de_lecture = ""
36		#' )[["viz"]]
37
38		creer_carte_1_1 <- function(data, carto, annee, bornes = NULL, palette = "pal_gouv_o", inverse = TRUE, maille = "EPCI",
39		titre = "\u00c9volution du nombre de logements sociaux par {maille}",
40		note_de_lecture = "", na_label = "Valeurs manquantes", decimales = 0, ...) {
41
42		# récupérer le code de la région à partir du jeu de données
43	1x	reg <- data %>%
44	1x	dplyr::filter(.data$TypeZone == "R\u00e9gions", .data$Zone_ref == TRUE) %>%
45	1x	dplyr::slice(1) %>%
46	1x	dplyr::pull("CodeZone") %>%
47	1x	as.character()
48
49		# preparer la table à visualiser
50	1x	data <- data %>%
51	1x	dplyr::filter(.data$millesime == annee) %>%
52	1x	mutate(valeur = mapfactory::format_fr(.data$evolution_n_nmoins1, dec = 1, pourcent = FALSE),
53	1x	valeur = ifelse(.data$evolution_n_nmoins1 > 0, paste0("+ ", .data$valeur, " %"), paste0(.data$valeur, " %")),
54	1x	message_survol = glue::glue("{.data$Zone} : \n {.data$nb_ls_actif} logements en {annee}\n {.data$valeur}"))
55
56	1x	map <- mapfactory::creer_carte(data = data, code_region = reg, carto = carto, maillage = maille, indicateur = evolution_n_nmoins1,
57	1x	type_viz = "choroplethe", palette = palette, inverse = inverse, interactive = TRUE,
58	1x	titre = glue::glue(titre), sous_titre = paste("entre ", annee - 1, " et ", annee),
59	1x	bas_de_page = dplyr::if_else(note_de_lecture != "" ,
60	1x	paste0(note_de_lecture, "\n\n", caption(sources = 1, mil_rpls = annee)),
61	1x	caption(sources = 1, mil_rpls = annee)),
62	1x	popover = "{.data$message_survol}",
63	1x	indicateur_popover = message_survol, decimales = decimales,
64	1x	evolution = TRUE, suffixe = " %", na_label = na_label, bornes = bornes, ...)
65
66		# donnees a faire figurer dans l'export xls
67	1x	codes_zones_a_garder <- c(COGiter::list_epci_in_reg(reg), COGiter::list_com_in_reg(reg))
68	1x	data_xls <- data %>%
69		# filtre sur la region et la maille de la carte, attention les noms de mailles dans TypeZone sont légèrement différents du paramètre maille
70	1x	dplyr::filter(grepl(tolower(maille), tolower(.data$TypeZone)), .data$CodeZone %in% codes_zones_a_garder) %>%
71	1x	dplyr::select("CodeZone", "Zone", "evolution_n_nmoins1", "nb_ls_actif")
72
73
74
75		# metadonnees a faire figurer dans la table des matiere de l'export xls
76	1x	index <- data.frame(onglet = "carte_1_1", titre = glue::glue(titre))
77
78	1x	return(list(viz = map, tab_xls = data_xls, meta = index))
79		}

1		#' Creation du tableau du chapitre Evolution du parc (nombre de logements sociaux, evolution annuelle, densite...)
2		#'
3		#' @description Mise en page du tableau du chapitre 1 au format html.
4		#'
5		#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref.
6		#' @param annee Le millesime renseigné par l'utilisateur.
7		#' @param epci un booléen pour indiquer si l'on souhaite détailler le tableau par EPCI.
8		#' @param add_scroll un booleen pour indique si l'on souhaite inserer une scrollbox. (par défaut FALSE)
9		#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Le parc locatif social {region} au 1er janvier {annee}")
10		#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
11		#'
12		#' @return Une liste de 3 objets : un tableau mis en page au format html (viz),
13		#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
14		#'
15		#' @importFrom dplyr filter select mutate arrange pull
16		#' @importFrom forcats fct_relevel fct_drop
17		#' @importFrom glue glue
18		#' @importFrom kableExtra kable kable_styling row_spec add_header_above add_indent footnote scroll_box
19		#' @importFrom rlang .data
20		#' @export
21		#'
22		#' @examples
23		#' indicateurs_rpls_illustrations <- lire_rpls_exemple() %>%
24		#' dplyr::filter(Zone_ref)
25		#'
26		#' creer_tableau_1_1(data = indicateurs_rpls_illustrations, annee = 2019, epci = TRUE,
27		#' add_scroll = FALSE, note_de_lecture = "")[["viz"]]
28		#'
29
30		creer_tableau_1_1 <- function(data, annee, epci = TRUE, add_scroll = FALSE, titre ="Le parc locatif social {local} au 1er janvier {annee}", note_de_lecture = ""){
31
32	3x	ch1tab <- data %>%
33		# filtre pour ne conserver que l annee n souhaitee par l utilisateur
34	3x	dplyr::filter(.data$millesime == annee) %>%
35	3x	dplyr::select("TypeZone", "CodeZone", "Zone", "nb_ls_actif", "evolution_n_nmoins1", "densite_ls_rp",
36	3x	"part_ls_qpv", "part_ls_ind", "part_ls_coll", "part_ls_etu") %>% # round 2
37		# Modification de l'ordre des levels de la variable TypeZone
38	3x	propre.rpls::arrange_zonage()
39
40
41	3x	if(!epci){
42	!	ch1tab <- dplyr::filter(ch1tab, .data$TypeZone != "Epci")
43		}
44
45		# Nom region
46	3x	nom_reg <- ch1tab %>%
47	3x	dplyr::filter(.data$TypeZone == "R\u00e9gions") %>%
48	3x	dplyr::pull("Zone") %>%
49	3x	as.character()
50
51		# creation du CC lieu pour exception la Reunion et Mayotte dans le titre du tableau
52		## TODO utiliser propre.datareg
53	3x	local <- ifelse(get_id_reg(nom_reg) %in% c("04","06") , paste0("de ", nom_reg), paste0("en ", nom_reg))
54
55
56	3x	ch1tableau <- ch1tab %>%
57		#selection des colonnes souhaitees
58	3x	dplyr::select(-"TypeZone", -"CodeZone") %>%
59		# Mise en place des titres de colonnes
60	3x	kableExtra::kable("html", col.names=c("Zone",glue::glue("Nombre de logements sociaux au 01/01/{annee}"),
61	3x	glue::glue("\u00c9volution {annee}/{annee-1} (en %)"),
62	3x	"Densit\u00e9 pour 100 r\u00e9sidences principales",
63	3x	"Part de logements en QPV<br/>(en %)",
64	3x	"Part des logements individuels<br/>(en %)",
65	3x	"Part des logements collectifs<br/>(en %)",
66	3x	"Part des logements \u00e9tudiants<br/>(en %)"),
67	3x	escape = FALSE,
68	3x	digits = c(0, 0, 1, 1, 1, 1, 1, 1), format.args = list(big.mark = " ", decimal.mark = ","),
69	3x	caption = glue::glue(titre)) %>%
70	3x	kableExtra::kable_styling(font_size = 12)%>%
71		# Formatage de la ligne "Région" : fond blanc, gras
72	3x	kableExtra::row_spec(which(dplyr::pull(ch1tab, "TypeZone") == "R\u00e9gions"), bold = TRUE, background = "#FFFFFF") %>%
73		# Formatage des lignes "Départements" : fond gris clair, gras
74	3x	kableExtra::row_spec(which(dplyr::pull(ch1tab, "TypeZone") == "D\u00e9partements"), bold = TRUE, background = "#E5E5E5") %>%
75		# Formatage des lignes "Epci" et "EPT" : fond blanc, taille 10
76	3x	kableExtra::row_spec(which(dplyr::pull(ch1tab, "TypeZone") %in% c("EPT", "Epci")), bold = FALSE, background = "#FFFFFF",
77	3x	font_size = 10) %>%
78		# Formatage des lignes "France" : fond gris foncé, gras
79	3x	kableExtra::row_spec(which(dplyr::pull(ch1tab, "TypeZone") == "France"), bold = TRUE, background = "#C4C4C4") %>%
80		# création d'un chapeau pour les variables de typo ind/col/etudiant
81	3x	kableExtra::add_header_above(c(" " = 5, "Type de logement" = 3)) %>%
82		## Ajout d'une indentation pour les lignes "EPT" et "Epci"
83	3x	kableExtra::add_indent(which(dplyr::pull(ch1tab, "TypeZone") %in% c("EPT", "Epci"))) %>%
84		# Creation note de bas de page avec la source et l ajout parametrable d une note de lecture
85	3x	kableExtra::footnote(general = paste0(dplyr::if_else(note_de_lecture != "",
86	3x	paste0(note_de_lecture, "\n"),
87		""),
88	3x	caption(sources = 2, mil_rpls = annee)), general_title = "")
89
90		# insere une scrollbox pour une meilleure lisibilite
91	3x	if (add_scroll) {
92	!	ch1tableau <- ch1tableau %>%
93	!	kableExtra::scroll_box(width = "100%", height = "500px", fixed_thead = TRUE)
94		}
95
96		# metadonnees a faire figurer dans la table des matiere de l'export xls
97	3x	index <- data.frame(onglet = "tableau_1_1", titre = glue::glue(titre))
98
99	3x	return(list(viz = ch1tableau, tab_xls = ch1tab, meta = index))
100
101		}

1		#' Chapitre 3: Verbatim
2		#'
3		#' @description Production des commentaires verbatim du chapitre 3.
4
5		#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref
6		#' @param annee Le millesime renseigné par l'utilisateur (au format numérique)
7		#'
8		#' @return Un vecteur de 4 chaînes de caractères comprenant l'intertitre, les commentaires, le titre et le texte de l encadre du chapitre 3
9		#'
10		#' @importFrom dplyr filter arrange slice mutate case_when pull
11		#' @importFrom glue glue
12		#' @importFrom propre.datareg datareg maj1let
13		#' @importFrom rlang .data
14		#'
15		#' @export
16		#'
17		#' @examples
18		#' indic_rpls_ref <- propre.rpls::lire_rpls_exemple() %>%
19		#' dplyr::filter(Zone_ref)
20		#' verbatim3 <- creer_verbatim_3(data = indic_rpls_ref, annee = 2019)
21		#' verbatim3$encadre_paragraphe
22
23
24		creer_verbatim_3 <- function(data, annee) {
25
26		# on calcule d'abord les indicateurs necessaires aux commentaires
27	5x	mise_en_serv <- data %>%
28	5x	dplyr::filter(grepl("gions", .data$TypeZone)) %>%
29	5x	dplyr::arrange(desc(.data$millesime)) %>%
30	5x	dplyr::slice(1:5) %>%
31	5x	dplyr::mutate(rang = rank(.data$nb_mes, na.last = TRUE, ties.method = "first")) %>%
32	5x	dplyr::mutate(class_mes = dplyr::case_when(
33	5x	.data$rang == 1 ~ "du plus faible volume",
34	5x	.data$rang == 2 ~ "du deuxi\u00e8me plus faible volume",
35	5x	.data$rang == 3 ~ "du volume m\u00e9dian",
36	5x	.data$rang == 4 ~ "du deuxi\u00e8me plus important volume",
37	5x	.data$rang == 5 ~ "du plus important volume",
38	5x	TRUE ~ "")
39		) %>%
40	5x	dplyr::filter(.data$millesime == annee) %>%
41	5x	dplyr::mutate(pourc_lgt_neuf = ((.data$nb_mes_qpv_construit_org + .data$nb_mes_qpv_acq_vefa + .data$nb_mes_nonqpv_construit_org + .data$nb_mes_nonqpv_acq_vefa) / .data$nb_mes * 100) %>% format_fr_pct,
42	5x	pourc_lgt_neuf_cons = ((.data$nb_mes_qpv_construit_org + .data$nb_mes_nonqpv_construit_org) / .data$nb_mes * 100) %>% format_fr_pct ,
43	5x	pourc_lgt_neuf_vefa = ((.data$nb_mes_qpv_acq_vefa + .data$nb_mes_nonqpv_acq_vefa) / .data$nb_mes * 100) %>% format_fr_pct,
44	5x	pourc_lgt_acquis = ((.data$nb_mes_qpv_acq_av_travaux + .data$nb_mes_qpv_acq_ss_travaux + .data$nb_mes_nonqpv_acq_av_travaux + .data$nb_mes_nonqpv_acq_ss_travaux) / .data$nb_mes * 100) %>% format_fr_pct,
45	5x	pourc_rehab = ((.data$nb_mes_qpv_acq_av_travaux + .data$nb_mes_nonqpv_acq_av_travaux) / (.data$nb_mes_qpv_acq_av_travaux + .data$nb_mes_qpv_acq_ss_travaux + .data$nb_mes_nonqpv_acq_av_travaux + .data$nb_mes_nonqpv_acq_ss_travaux) * 100) %>% format_fr_pct,
46	5x	nb_mes_acq_ss_travaux = .data$nb_mes_qpv_acq_ss_travaux + .data$nb_mes_nonqpv_acq_ss_travaux,
47	5x	nb_mes_acq_av_travaux = .data$nb_mes_qpv_acq_av_travaux + .data$nb_mes_nonqpv_acq_av_travaux)
48
49	5x	annee_prec <- data %>%
50	5x	dplyr::filter(grepl("gions", .data$TypeZone), .data$millesime == annee - 1)
51
52	5x	mes_acq <- dplyr::case_when((mise_en_serv$nb_mes_acq_ss_travaux + mise_en_serv$nb_mes_acq_av_travaux) == 0 ~ 0,
53	5x	mise_en_serv$nb_mes_acq_av_travaux == 0 ~ 1,
54	5x	TRUE ~ 2)
55
56
57		# on récupère les formulations idiomatiques grâce à {propre.datareg}
58	5x	id_reg <- dplyr::filter(data, grepl("gions", .data$TypeZone)) %>%
59	5x	dplyr::pull("CodeZone") %>% unique %>% as.character
60	5x	verb_reg <- propre.datareg::datareg(code_reg = id_reg)
61
62
63		# on cree ensuite une liste nommee des differents parametres
64	5x	verb3 <- list(nom_reg = verb_reg$dans_la_region_nom_region,
65	5x	annee_prec = annee - 1,
66	5x	nb_mes = mise_en_serv$nb_mes %>%
67	5x	format_fr_nb(dec = 0, big_mark = " "),
68	5x	class_mes = mise_en_serv$class_mes,
69	5x	pourc_lgt_neuf = mise_en_serv$pourc_lgt_neuf,
70	5x	pourc_lgt_neuf_cons = mise_en_serv$pourc_lgt_neuf_cons,
71	5x	pourc_lgt_neuf_vefa = mise_en_serv$pourc_lgt_neuf_vefa,
72	5x	pourc_lgt_acquis = mise_en_serv$pourc_lgt_acquis,
73	5x	pourc_rehab = mise_en_serv$pourc_rehab,
74	5x	nb_ls_actif_n = mise_en_serv$nb_ls_actif %>%
75	5x	format_fr_nb(dec = 0, big_mark = " "),
76	5x	nb_ls_actif_n_1 = annee_prec$nb_ls_actif %>%
77	5x	format_fr_nb(dec = 0, big_mark = " "),
78	5x	nb_demolition = mise_en_serv$nb_demolition %>%
79	5x	format_fr_nb(dec = 0, big_mark = " "),
80	5x	nb_ventes = mise_en_serv$nb_ventes %>%
81	5x	format_fr_nb(dec = 0, big_mark = " "),
82	5x	nb_sorties_autres_motifs= mise_en_serv$nb_sorties_autres_motifs %>%
83	5x	format_fr_nb(dec = 0, big_mark = " "),
84	5x	nb_vente_bailleur = mise_en_serv$nb_vente_bailleur %>%
85	5x	format_fr_nb(dec = 0, big_mark = " "))
86
87
88		# production du verbatim a partir des elements precedents
89	5x	verbatim_chap_3 <- list(intertitre = "", commentaires = "", encadre_titre = "", encadre_paragraphe= "")
90	5x	verbatim_chap_3$intertitre <- glue::glue("En {verb3$annee_prec}, {verb3$nb_mes} logements sociaux ont \u00e9t\u00e9 mis en service")
91	5x	verbatim_chap_3$commentaires <- glue::glue("Entre le 2 janvier {verb3$annee_prec} et le 1er janvier {annee}, ",
92	5x	"{verb3$nb_mes} logements sociaux ont \u00e9t\u00e9 mis en service {verb3$nom_reg}. ",
93	5x	"Il s\u0027agit {verb3$class_mes} constat\u00e9 sur les cinq derni\u00e8res ann\u00e9es. ",
94	5x	"Parmi ces mises en service, {verb3$pourc_lgt_neuf} sont des logements neufs, ",
95	5x	"c\u0027est-\u00e0-dire construits par l\u0027organisme ({verb3$pourc_lgt_neuf_cons}) ",
96	5x	"ou acquis en vente en l\u0027\u00e9tat futur d\u0027ach\u00e8vement ({verb3$pourc_lgt_neuf_vefa}).")
97
98	5x	if (mes_acq == 0) {
99	!	verbatim_chap_3$commentaires <- glue::glue(
100	!	verbatim_chap_3$commentaires,
101	!	" En {verb3$annee_prec}, aucun bailleur n\u0027a mis en service de logement acquis dans le parc priv\u00e9."
102		)
103		} else {
104	5x	verbatim_chap_3$commentaires <- glue::glue(
105	5x	verbatim_chap_3$commentaires,
106	5x	" Les logements mis en service peuvent \u00eatre \u00e9galement des logements existants acquis en dehors du parc social. ",
107	5x	"Les acquisitions dans le parc priv\u00e9 repr\u00e9sentent {verb3$pourc_lgt_acquis} des mises en service en {verb3$annee_prec}"
108		)
109		}
110
111	!	if (mes_acq == 1) { verbatim_chap_3$commentaires <- glue::glue(verbatim_chap_3$commentaires, ".")}
112	5x	if (mes_acq == 2) {
113	5x	verbatim_chap_3$commentaires <- glue::glue(verbatim_chap_3$commentaires,
114	5x	" ; {verb3$pourc_rehab} d\u0027entre elles se font avec des travaux de r\u00e9habilitation.")}
115
116	5x	verbatim_chap_3$encadre_titre <- glue::glue("Les mouvements du parc en {verb3$annee_prec}")
117	5x	verbatim_chap_3$encadre_paragraphe <- glue::glue(
118	5x	'{propre.datareg::maj1let(verb3$nom_reg)}, le nombre de logements sociaux est de {verb3$nb_ls_actif_n} au 1er janvier {annee} contre {verb3$nb_ls_actif_n_1} au 1er janvier {verb3$annee_prec}.
119	5x	Au cours de l\u0027ann\u00e9e {verb3$annee_prec}, {verb3$nb_mes} logements sociaux ont \u00e9t\u00e9 mis en service dans la r\u00e9gion. Dans le m\u00eame temps, {ifelse(verb3$nb_demolition>0,verb3$nb_demolition,"")}{ifelse(verb3$nb_demolition == 1," logement a \u00e9t\u00e9 d\u00e9moli, ","")}{ifelse(verb3$nb_demolition>1," logements ont \u00e9t\u00e9 d\u00e9molis, ","")}{ifelse(verb3$nb_ventes>0,verb3$nb_ventes,"")}{ifelse(verb3$nb_ventes == 1," logement a \u00e9t\u00e9 vendu","")}{ifelse(verb3$nb_ventes>1," logements ont \u00e9t\u00e9 vendus","")}{ifelse(verb3$nb_sorties_autres_motifs>0,", et ","")}{ifelse(verb3$nb_sorties_autres_motifs>0,verb3$nb_sorties_autres_motifs,"")}{ifelse(verb3$nb_sorties_autres_motifs == 1," logement a chang\u00e9 d\u0027usage ou a \u00e9t\u00e9 restructur\u00e9","")}{ifelse(verb3$nb_sorties_autres_motifs>1," logements ont chang\u00e9 d\u0027usage ou ont \u00e9t\u00e9 restructur\u00e9s","")}.
120	5x	{ifelse(verb3$nb_vente_bailleur>0,"Sans incidence sur le nombre de logements du parc social, ","")}{ifelse(verb3$nb_vente_bailleur>0,verb3$nb_vente_bailleur,"")}{ifelse(verb3$nb_vente_bailleur == 1," logement a fait l\u0027objet d\u0027un transfert entre bailleurs. ","")}{ifelse(verb3$nb_vente_bailleur>1," logements ont fait l\u0027objet d\u0027un transfert entre bailleurs. ","")}'
121		)
122
123
124	5x	verbatim_chap_3
125		}
126

1		#' Creation de la 1ere carte du chapitre sur la tension du parc, representant le taux de vacance structurelle par EPCI.
2		#'
3		#' @description Création de la carte représentant le taux de vacance structurelle par EPCI pour l'année N choisie.
4		#'
5		#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur.
6		#' @param annee Une année parmi les millésimes sélectionnables par l'utilisateur, au format numérique.
7		#' @param carto La table des fonds de carte realisee avec \code{mapfactory::\link{fond_carto}}.
8		#' @param bornes Les bornes manuelles de la légende, mettre à NULL pour utiliser la méthode par défaut (quantile).
9		#' @param palette choix de la palette de couleurs parmi celle de \code{gouvdown::\link{scale_color_gouv_discrete}}
10		#' @param inverse choix du sens de la progression des couleurs : du plus foncé au plus clair (FALSE) ou du plus clair au plus foncé (TRUE)
11		#' @param maille le maillage souhaite pour la carte, a choisir parmi "commune", "EPCI" ou "département". "EPCI" par defaut.
12		#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Taux de vacance structurelle par {maille} au 1er janvier {annee}")
13		#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
14		#' @param na_label L'etiquette à afficher dans la legende pour les valeurs manquantes ("Valeurs manquantes" par défaut).
15		#' @param ... autres paramètres de la fonction[\code{mapfactory::creer_carte}](https://dreal-pdl.gitlab-pages.din.developpement-durable.gouv.fr/csd/mapfactory/reference/creer_carte.html).
16		#'
17		#' @return Une liste de 3 objets : une carte choroplethe mise en page au format html (viz),
18		#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
19		#'
20		#' @importFrom dplyr filter slice pull if_else select
21		#' @importFrom glue glue
22		#' @importFrom mapfactory creer_carte
23		#' @importFrom stringr str_wrap
24		#' @importFrom COGiter list_epci_in_reg list_com_in_reg
25		#'
26		#' @export
27		#'
28		#' @examples
29		#' indic_rpls <- lire_rpls_exemple()
30		#'
31		#' creer_carte_5_1(
32		#' data = indic_rpls,
33		#' annee = 2019,
34		#' carto = mapfactory::fond_carto("Corse"),
35		#' bornes = NULL,
36		#' note_de_lecture = ""
37		#' )[["viz"]]
38
39		creer_carte_5_1 <- function(data, annee, carto, bornes = NULL, palette = "pal_gouv_o", inverse = FALSE, maille = "EPCI",
40		titre = "Taux de vacance structurelle par {maille} au 1er janvier {annee}",
41		note_de_lecture = "", na_label = "Valeurs manquantes", ...) {
42
43		# récupérer le code de la région à partir du jeu de données
44	1x	reg <- data %>%
45	1x	dplyr::filter(.data$TypeZone == "R\u00e9gions", .data$Zone_ref == TRUE) %>%
46	1x	dplyr::slice(1) %>%
47	1x	dplyr::pull("CodeZone") %>%
48	1x	as.character()
49
50		# preparer la table à visualiser
51	1x	data <- data %>%
52	1x	dplyr::filter(.data$millesime == annee)
53
54	1x	map <- mapfactory::creer_carte(data = data, code_region = reg, carto = carto, maillage = maille, indicateur = taux_vacance_str,
55	1x	type_viz = "choroplethe", palette = palette, inverse = inverse, interactive = TRUE,
56	1x	titre = stringr::str_wrap(glue::glue(titre), width = 30), decimales = 1,
57	1x	bas_de_page = dplyr::if_else(note_de_lecture != "" ,
58	1x	paste0(note_de_lecture, "\n\n", caption(sources = 1, mil_rpls = annee)),
59	1x	caption(sources = 1, mil_rpls = annee)),
60	1x	evolution = FALSE, suffixe = " %", na_label = na_label, bornes = bornes, ...)
61
62		# donnees a faire figurer dans l'export xls
63	1x	codes_zones_a_garder <- c(COGiter::list_epci_in_reg(reg), COGiter::list_com_in_reg(reg))
64	1x	data_xls <- data %>%
65		# filtre sur la region et la maille de la carte, attention les noms de mailles dans TypeZone sont légèrement différents du paramètre maille
66	1x	dplyr::filter(grepl(tolower(maille), tolower(.data$TypeZone)), .data$CodeZone %in% codes_zones_a_garder) %>%
67	1x	dplyr::select("CodeZone", "Zone", "taux_vacance_str")
68
69		# metadonnees a faire figurer dans la table des matiere de l'export xls
70	1x	index <- data.frame(onglet = "carte_5_1", titre = glue::glue(titre))
71
72	1x	return(list(viz = map, tab_xls = data_xls, meta = index))
73
74		}

1		#' Creation du tableau du chapitre sur les mises en service et les sorties.
2		#'
3		#' @description Création du tableau 1 du chapitre 3 en html.
4		#'
5		#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref.
6		#' @param annee Une année parmi les millesimes sélectionnables par l'utilisateur, au format numerique.
7		#' @param epci un booléen pour indiquer si l'on souhaite détailler le tableau par EPCI.
8		#' @param add_scroll un booleen pour indique si l'on souhaite inserer une scrollbox. (par défaut FALSE)
9		#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Les mouvements (mises en service et sorties) opérés {region} en {annee-1}")
10		#' @param note_de_lecture une chaine de caractère si vous voulez ajouter une note de lecture en dessous des sources
11		#'
12		#' @return Une liste de 3 objets : un tableau mis en page au format html (viz),
13		#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
14		#'
15		#' @importFrom dplyr filter select mutate left_join arrange pull
16		#' @importFrom forcats fct_relevel fct_drop
17		#' @importFrom kableExtra kable kable_styling row_spec add_indent add_header_above footnote scroll_box
18		#' @importFrom tidyr pivot_wider
19		#' @importFrom glue glue
20		#' @importFrom rlang .data
21		#'
22		#' @export
23		#'
24		#' @examples
25		#' indicateurs_rpls_illustrations <- lire_rpls_exemple() %>%
26		#' dplyr::filter(Zone_ref)
27		#'
28		#' creer_tableau_3_1(data = indicateurs_rpls_illustrations, annee = 2019, epci = FALSE,
29		#' add_scroll = FALSE, note_de_lecture = "")[["viz"]]
30
31		creer_tableau_3_1 <- function(data, annee, epci = FALSE, add_scroll = FALSE, note_de_lecture = "",
32		titre ="Les mouvements (mises en service et sorties) op\u00e9r\u00e9s {local} en {annee-1}"){
33
34		# Création du dataset utile pour la production du tableau
35	1x	tab <- data %>%
36		# Filtre sur l'année N et N-1
37	1x	dplyr::filter(.data$millesime %in% c(annee,annee-1)) %>%
38		# Sélection des variables
39	1x	dplyr::select("TypeZone", "Zone", "CodeZone", "millesime", "nb_ls_actif") %>%
40		# Modification des modalités de la variable "millesime"
41	1x	dplyr::mutate(millesime = ifelse(.data$millesime == annee,"n","n_moins1")) %>%
42		# Passage du format long au format large (millesime)
43	1x	tidyr::pivot_wider(names_from = "millesime", names_prefix = "nb_ls_actif_", values_from = "nb_ls_actif") %>%
44		# Jointure avec les autres variables utiles
45	1x	dplyr::left_join(data %>%
46		# Filtre sur l'annee N
47	1x	dplyr::filter(.data$millesime == annee) %>%
48		# Sélection des variables utiles
49	1x	dplyr::select("TypeZone", "Zone", "CodeZone", "millesime", "nb_mes", "nb_ventes",
50	1x	"nb_vente_bailleur", "nb_demolition", "nb_sorties_autres_motifs"),
51	1x	by = c("TypeZone", "Zone", "CodeZone")) %>%
52		# Modification de l'ordre des levels de la variable TypeZone
53	1x	dplyr::mutate(nb_rattra_omiss = .data$nb_ls_actif_n - .data$nb_ls_actif_n_moins1 - .data$nb_mes + .data$nb_ventes +
54	1x	.data$nb_demolition + .data$nb_sorties_autres_motifs) %>%
55		# Tri de la table pour faire apparaitre dans l'ordre FM/Région/Département/EPT/EPCI par nature puis par ordre alphabetique
56	1x	propre.rpls::arrange_zonage()
57
58
59	1x	if(!epci){
60	1x	tab <- dplyr::filter(tab, .data$TypeZone != "Epci")
61		}
62
63		# Nom region
64	1x	nom_reg <- tab %>%
65	1x	dplyr::filter(.data$TypeZone == "R\u00e9gions") %>%
66	1x	dplyr::pull("Zone") %>%
67	1x	as.character()
68
69		# creation du CC lieu pour exception la Reunion et Mayotte dans le titre du tableau
70	1x	local <- ifelse(get_id_reg(nom_reg) %in% c("04","06") , paste0("\u00e0 ", nom_reg), paste0("en ", nom_reg))
71
72		# Création du tableau
73	1x	tableau <- tab %>%
74		# Sélection des variables utiles
75	1x	dplyr::select("Zone", "nb_ls_actif_n", "nb_ls_actif_n_moins1", "nb_mes", "nb_ventes", "nb_demolition",
76	1x	"nb_sorties_autres_motifs", "nb_rattra_omiss", "nb_vente_bailleur") %>%
77		# Mise en place des titres de colonnes
78	1x	kableExtra::kable("html", col.names=c("Zone",
79	1x	paste0("Logements sociaux au 01/01/", annee),
80	1x	paste0("Logements sociaux au 01/01/", annee-1),
81	1x	"Mises en service",
82	1x	"Ventes\u00a0*",
83	1x	"D\u00e9molitions",
84	1x	"Sorties pour un autre motif\u00a0**",
85	1x	"Rattrapages et omis- sions\u00a0***",
86	1x	"Transferts \u00e0 un autre bail- leur\u00a0****"),
87	1x	format.args=list(big.mark=" "),
88	1x	caption = glue::glue(titre)) %>%
89		# Formatage de la taille des caractères
90	1x	kableExtra::kable_styling(font_size = 10) %>%
91		# Formatage de la ligne "R\u00e9gion" : fond blanc, gras
92	1x	kableExtra::row_spec(which(dplyr::pull(tab, "TypeZone") == "R\u00e9gions"), bold = TRUE, background = "#FFFFFF") %>%
93		# Formatage des lignes "D\u00e9partements" : fond gris clair, gras
94	1x	kableExtra::row_spec(which(dplyr::pull(tab, "TypeZone") == "D\u00e9partements"), bold = TRUE, background = "#E5E5E5") %>%
95		# Formatage des lignes "EPT" et "EPCI" : fond blanc, taille 9
96	1x	kableExtra::row_spec(which(dplyr::pull(tab, "TypeZone") %in% c("EPT", "Epci")), bold = FALSE, background = "#FFFFFF",
97	1x	font_size = 9) %>%
98		# Ajout d'une indentation pour les lignes "Epci" et "EPT"
99	1x	kableExtra::add_indent(which(dplyr::pull(tab, "TypeZone") %in% c("EPT", "Epci"))) %>%
100		# Formatage des lignes "France" : fond gris foncé, gras
101	1x	kableExtra::row_spec(which(dplyr::pull(tab, "TypeZone") == "France"), bold = TRUE, background = "#C4C4C4") %>%
102		# Formatage des largeurs des colonnes : 5, 6, 7, 8 et 9
103	1x	kableExtra::column_spec(column = 5, width = "1.8cm") %>%
104	1x	kableExtra::column_spec(column = 6, width = "1.8cm") %>%
105	1x	kableExtra::column_spec(column = 7, width = "2.2cm") %>%
106	1x	kableExtra::column_spec(column = 8, width = "2.2cm") %>%
107	1x	kableExtra::column_spec(column = 9, width = "2.2cm") %>%
108		# création d'un chapeau pour les variables relatives aux sorties
109	1x	kableExtra::add_header_above(c(" " = 4, "Sorties" = 3, " " = 2)) %>%
110		# Création note de bas de page avec la source et l ajout parametrable d une note de lecture
111	1x	kableExtra::footnote(general = paste0("\n* Ventes \u00e0 l'occupant et autres ventes.
112	1x	** Logements fusionn\u00e9s, logements scind\u00e9s ou logements sortis pour autre motif.
113	1x	*** \u00c9carts observ\u00e9s entre les d\u00e9clarations des bailleurs sociaux entre ",
114	1x	annee-1, " et ", annee, ", tant vis-\u00e0-vis des sorties que des entr\u00e9es dans le parc social.
115	1x	**** Les logements transf\u00e9r\u00e9s d'un bailleur \u00e0 un autre restent actifs dans le r\u00e9pertoire.
116	1x	\n",
117	1x	dplyr::if_else(note_de_lecture != "",
118	1x	paste0(note_de_lecture, "\n"),
119		""),
120	1x	caption(sources = 1, mil_rpls = annee)), general_title = " ")
121
122
123		# insere une scrollbox pour une meilleure lisibilite
124	1x	if (add_scroll) {
125	!	tableau <- tableau %>%
126	!	kableExtra::scroll_box(width = "100%", height = "500px", fixed_thead = TRUE)
127		}
128
129		# donnees a faire figurer dans l'export xls
130	1x	data_xls <- tab %>%
131	1x	dplyr::select("Zone", "nb_ls_actif_n", "nb_ls_actif_n_moins1", "nb_mes", "nb_ventes", "nb_demolition",
132	1x	"nb_sorties_autres_motifs", "nb_rattra_omiss", "nb_vente_bailleur") %>%
133	1x	dplyr::rename("nb_mise_en_service" = "nb_mes")
134
135		# metadonnees a faire figurer dans la table des matiere de l'export xls
136	1x	index <- data.frame(onglet = "tableau_3_1", titre = glue::glue(titre))
137
138	1x	return(list(viz = tableau, tab_xls = data_xls, meta = index))
139
140
141
142		}

1		#' Creation de deux graphiques du chapitre anciennete et etat energetique, represantant la repartition des logements selon la classe DPE energie (A a G) et selon la classe DPE effet de serre (A a G).
2		#'
3		#' @description Création de deux diagrammes en barres représentant le pourcentage de logements selon les étiquettes DPE (de A à G) pour
4		#' la consommation d'énergie et les émissions de gaz à effet de serre à l'échelle régionale.
5		#'
6		#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref.
7		#' @param annee Une année parmi les millésimes sélectionnables par l'utilisateur, au format numérique.
8		#' @param titre_nrj une chaine de caractère si vous voulez ajouter un titre spécifique au graphe sur le dpe energie. (par défaut: "Répartition des logements selon leur classe de consommation d'énergie au 1er janvier {annee}")
9		#' @param titre_effet_serre une chaine de caractère si vous voulez ajouter un titre spécifique au graphe sur le dpe CO2 (par défaut: "Répartition des logements selon leur classe d'impact des consommations d'énergie sur l'effet de serre au 1er janvier {annee}")
10		#' @param note_de_lecture_nrj une chaine de caractère si voulez faire une note de lecture au 1er graph sur le dpe energie
11		#' @param note_de_lecture_effet_serre une chaine de caractère si voulez faire une note de lecture au 2e graph sur le dpe CO2
12		#'
13		#' @return une composition de deux graphiques en barres interactifs pour les régions métropolitaines, rien sinon
14		#' @return Une liste de 3 objets : une composition de 2 graphiques en barres interactifs pour les régions métropolitaines, vide sinon (viz),
15		#' la table des données visualisées (tab_xls) et leurs métadonnées (meta).
16
17		#'
18		#' @importFrom dplyr filter select mutate pull group_by
19		#' @importFrom ggiraph geom_bar_interactive ggiraph
20		#' @importFrom ggplot2 ggplot aes position_dodge labs guides guide_legend theme scale_fill_discrete scale_fill_manual coord_flip geom_text element_blank scale_y_continuous
21		#' @importFrom gouvdown scale_fill_gouv_discrete
22		#' @importFrom stringr str_wrap
23		#' @importFrom tidyr pivot_longer
24		#' @importFrom rlang .data
25		#' @importFrom forcats fct_relevel fct_rev
26		#' @importFrom scales percent
27		#' @importFrom patchwork plot_layout
28		#' @importFrom glue glue
29		#' @export
30		#'
31		#' @examples
32		#' indicateurs_rpls_illustrations <- lire_rpls_exemple() %>%
33		#' dplyr::filter(Zone_ref)
34		#'
35		#' creer_graphe_4_1(data = indicateurs_rpls_illustrations, annee = 2019,
36		#' note_de_lecture_nrj = "",
37		#' note_de_lecture_effet_serre = "")[["viz"]]
38
39
40		creer_graphe_4_1 <- function(data, annee,
41		titre_nrj = NULL,
42		titre_effet_serre = NULL,
43		note_de_lecture_nrj = "",
44		note_de_lecture_effet_serre = ""){
45	1x	caption_champ <- "Champ : logements ayant un DPE renseign\u00e9 et \nr\u00e9alis\u00e9 avant le 1er juillet 2021\n\n"
46	1x	if (is.null(titre_nrj)){
47	1x	titre_nrj <- "R\u00e9partition des logements selon leur classe de consommation d'\u00e9nergie au 1er janvier {annee}"}
48	1x	if (is.null(titre_effet_serre)){
49	1x	titre_effet_serre <- "R\u00e9partition des logements selon leur classe d'impact des consommations d'\u00e9nergie sur l'effet de serre au 1er janvier {annee}"}
50		# un booleen pour l'appartenance de la région à la France métropolitaine
51	1x	metro <- dplyr::filter(data, grepl("FRMETRO", .data$CodeZone)) %>%
52	1x	dplyr::pull("CodeZone") %>% unique() %>%
53	1x	as.character() == "FRMETRO"
54
55		# la fonction ne renvoie rien si la région choisie est DROM
56	1x	if(metro) {
57		# Création du dataset utile à la production du graphique
58	1x	tab <- data %>%
59		# Filtre pour ne garder que les données de la région choisie et du millésime sélectionné
60	1x	dplyr::filter(.data$TypeZone == "R\u00e9gions",
61	1x	.data$millesime == annee) %>%
62		# Sélection des variables utiles pour le graphique
63	1x	dplyr::select("TypeZone", "Zone", "millesime",
64	1x	"nb_ls_dpe_ener_A", "nb_ls_dpe_ener_B", "nb_ls_dpe_ener_C", "nb_ls_dpe_ener_D",
65	1x	"nb_ls_dpe_ener_E", "nb_ls_dpe_ener_F", "nb_ls_dpe_ener_G",
66	1x	"nb_ls_dpe_serre_A", "nb_ls_dpe_serre_B", "nb_ls_dpe_serre_C", "nb_ls_dpe_serre_D",
67	1x	"nb_ls_dpe_serre_E", "nb_ls_dpe_serre_F", "nb_ls_dpe_serre_G") %>%
68		# Passage du format large au format long
69	1x	tidyr::pivot_longer(-c("TypeZone", "Zone", "millesime"),
70	1x	values_to = "Nb_logements", names_sep = "_", names_to = c("Type_dpe", "Classe_dpe"),
71	1x	names_prefix = "nb_ls_dpe_") %>%
72		# Modification des modalités de la variable Type_dpe
73	1x	dplyr::mutate(Type_dpe = ifelse(.data$Type_dpe == "ener", "Classe \u00c9nergie", "Classe Effet de serre"),
74		# Modification de l'ordre des levels
75	1x	Type_dpe = forcats::fct_relevel(.data$Type_dpe, "Classe \u00c9nergie", "Classe Effet de serre")) %>%
76	1x	dplyr::group_by(.data$Type_dpe) %>%
77	1x	dplyr::mutate(Percent_logements = 100 * prop.table(.data$Nb_logements))
78
79
80	1x	ymax = max(dplyr::pull(tab,"Percent_logements")) + 30
81
82		# Création du graphique ENERGIE
83	1x	tab1 <- tab %>%
84	1x	dplyr::filter(.data$Type_dpe == "Classe \u00c9nergie")
85
86	1x	graphe1 <- ggplot2::ggplot(data = tab1, mapping = ggplot2::aes(x = forcats::fct_rev(factor(.data$Classe_dpe)),
87	1x	y = .data$Percent_logements, fill = .data$Classe_dpe)) +
88		# Création graphique en barres en mode interactif
89	1x	ggiraph::geom_bar_interactive(stat = "identity", data_id = row.names(tab1),
90	1x	tooltip = dplyr::pull(tab1, "Percent_logements") %>% format_fr_pct(),
91	1x	position = ggplot2::position_dodge()) +
92	1x	ggplot2::coord_flip() +
93	1x	ggplot2::geom_label(ggplot2::aes(label = format_fr_pct(.data$Percent_logements)),
94	1x	vjust = 0.3, hjust = -0.2 , size = 3.5, label.size = 0, fill = "white") +
95	1x	ggplot2::geom_label(ggplot2::aes(x = forcats::fct_rev(factor(.data$Classe_dpe)), y = ymax), hjust = "right", label.size = 0, fill = "white",
96	1x	label = c("\u2264 50 kWh/m\u00b2 par an","51 \u00e0 90","91 \u00e0 150","151 \u00e0 230","231 \u00e0 330","331 \u00e0 450","> 450")) +
97		# Paramétrage titre, sous-titre, axes ...
98	1x	ggplot2::labs(title = stringr::str_wrap(glue::glue(titre_nrj), width = 50),
99	1x	subtitle = "Unit\u00e9 : %",
100	1x	x = "",
101	1x	y = "",
102	1x	caption = dplyr::if_else(note_de_lecture_nrj != "" ,
103	1x	paste0(note_de_lecture_nrj, "\n", caption_champ, caption(sources = 1, mil_rpls = annee)),
104	1x	paste0(caption_champ, caption(sources = 1, mil_rpls = annee)))) +
105		# Retrait du titre de la légende
106	1x	ggplot2::guides(fill = ggplot2::guide_legend(title = "")) +
107		# Positionnement de la légende sous le graphique
108	1x	ggplot2::theme(legend.position = "none",
109	1x	axis.text.x = ggplot2::element_blank(),
110	1x	axis.ticks.x = ggplot2::element_blank()) +
111	1x	ggplot2::scale_y_continuous(lim = c(0,ymax))+
112	1x	ggplot2::scale_fill_manual(breaks = c("A", "B", "C", "D", "E", "F", "G"),
113	1x	values = c("#319A31","#33CC33","#CCFF33","#FFFF00","#FFCC00","#FF9A33","#ff0000"))
114
115		# Création du graphique GES
116	1x	tab2 <- tab %>%
117	1x	dplyr::filter(.data$Type_dpe == "Classe Effet de serre")
118
119	1x	graphe2 <- ggplot2::ggplot(data = tab2, mapping = ggplot2::aes(x = forcats::fct_rev(factor(.data$Classe_dpe)),
120	1x	y = .data$Percent_logements, fill = .data$Classe_dpe)) +
121		# Création graphique en barres en mode interactif
122	1x	ggiraph::geom_bar_interactive(stat = "identity", data_id = row.names(tab2),
123	1x	tooltip = dplyr::pull(tab2, "Percent_logements") %>% format_fr_pct(),
124	1x	position = ggplot2::position_dodge()) +
125	1x	ggplot2::coord_flip()+
126	1x	ggplot2::geom_label(ggplot2::aes(label = format_fr_pct(.data$Percent_logements)),
127	1x	vjust = 0.3, hjust = -0.2 , size = 3.5, label.size = 0, fill = "white") +
128	1x	ggplot2::geom_label(ggplot2::aes(x = forcats::fct_rev(factor(.data$Classe_dpe)), y = ymax), hjust = "right",
129	1x	label.size = 0, fill = "white",
130	1x	label = c("\u2264 5 kg eq CO2/m\u00b2 par an", "6 \u00e0 10","11 \u00e0 20","21 \u00e0 35",
131	1x	"36 \u00e0 55", "56 \u00e0 80","> 80")) +
132		# Paramétrage titre, sous-titre, axes ...
133	1x	ggplot2::labs(title = stringr::str_wrap(glue::glue(titre_effet_serre), width = 50),
134	1x	subtitle = "Unit\u00e9 : %",
135	1x	x = "",
136	1x	y = "",
137	1x	caption = dplyr::if_else(note_de_lecture_effet_serre != "" ,
138	1x	paste0(note_de_lecture_effet_serre, "\n", caption_champ, caption(sources = 1, mil_rpls = annee)),
139	1x	paste0(caption_champ, caption(sources = 1, mil_rpls = annee)))) +
140		# Retrait du titre de la légende
141	1x	ggplot2::guides(fill = ggplot2::guide_legend(title = "")) +
142		# Positionnement de la légende sous le graphique
143	1x	ggplot2::theme(legend.position = "none",
144	1x	axis.text.x = ggplot2::element_blank(),
145	1x	axis.ticks.x = ggplot2::element_blank()) +
146	1x	ggplot2::scale_y_continuous(lim = c(0, ymax))+
147	1x	ggplot2::scale_fill_manual(breaks = c("A", "B", "C", "D", "E", "F", "G"),
148	1x	values = c("#F6EDFD","#E1C2F8","#D4A9F5","#CB95F3","#BA72EF","#A74DEB","#8A19DF"))
149
150		#Patchwork des graphiques
151	1x	g <- graphe1 + graphe2 + patchwork::plot_layout(ncol = 1)
152
153		# Ajout de l'interactivité
154	1x	graphe <- ggiraph::ggiraph(ggobj = g, width_svg = 6, height_svg = 10)
155
156		# donnees a faire figurer dans l'export xls
157	1x	data_xls <- dplyr::select(tab, -"TypeZone")
158
159		# metadonnees a faire figurer dans la table des matiere de l'export xls
160	1x	index <- data.frame(onglet = "graphe_4_1", titre = glue::glue("R\u00e9partition des logements selon leur DPE au 1er janvier {annee}"))
161
162	1x	return(list(viz = graphe, tab_xls = data_xls, meta = index))
163
164
165		} else {
166	!	return(list(viz = NULL, tab_xls = NULL, meta = NULL))
167		}
168		}

1		#' Trier les zonages pour les tableaux
2		#' Cette fonction permet de trier les zonages des tableaux dans l'ordre suivant : region, departements, epci, totaux France et DROM.
3		#' Les epci sont tries par nature d'epci.
4		#'
5		#' @param data le dataframe en entrée
6		#'
7		#' @return un dataframe
8		#' @importFrom dplyr select mutate bind_rows across inner_join arrange case_when everything
9		#' @importFrom forcats fct_inorder fct_drop
10		#' @export
11		#'
12		#' @examples
13		#'indicateurs_rpls_ref <- lire_rpls_exemple() %>%
14		#' dplyr::filter(Zone_ref)
15		#'indicateurs_rpls_ref <- arrange_zonage(data = indicateurs_rpls_ref)
16		arrange_zonage <- function(data) {
17	7x	liste_zone <- COGiter::liste_zone %>%
18	7x	dplyr::select("TypeZone", "Zone", "CodeZone", "NATURE_EPCI")
19
20	7x	fr <- data.frame(
21	7x	TypeZone = c("France", "France", "France", "France"),
22	7x	Zone = c("France de province", "D\u00e9partements et r\u00e9gions d'outre-mer", "France m\u00e9tropolitaine", "France m\u00e9tropolitaine et DROM"),
23	7x	CodeZone = c("FRPROV", "DROM", "FRMETRO", "FRMETRODROM")
24		) %>%
25	7x	dplyr::mutate(dplyr::across(.cols = dplyr::everything(), .fns = ~ forcats::fct_inorder(as.factor(.x))))
26
27	7x	liste_zone_spe <- propre.rpls::zonage_spe %>%
28	7x	dplyr::select("TypeZone", "Zone", "CodeZone") %>%
29	7x	dplyr::mutate(dplyr::across(dplyr::contains("Zone"), ~forcats::fct_expand(.x, levels(liste_zone$.x)))) %>%
30	7x	unique()
31
32	7x	liste_zone <- dplyr::bind_rows(liste_zone, liste_zone_spe) %>%
33	7x	dplyr::mutate(CodeZone = forcats::fct_relevel(.data$CodeZone, sort)) %>%
34	7x	dplyr::arrange(.data$TypeZone, .data$CodeZone) %>%
35	7x	dplyr::bind_rows(fr)
36
37	7x	res <- data %>%
38	7x	dplyr::inner_join(liste_zone %>%
39	7x	dplyr::select("TypeZone", "Zone", "CodeZone", "NATURE_EPCI")) %>%
40	7x	dplyr::mutate(
41	7x	TypeZone = forcats::fct_expand(.data$TypeZone, levels(liste_zone$TypeZone)),
42	7x	TypeZone = forcats::fct_relevel(.data$TypeZone, "France", "R\u00e9gions", "D\u00e9partements", "EPT", "Epci"),
43	7x	var_de_tri = dplyr::case_when(
44	7x	.data$TypeZone == "Epci" ~ paste0(as.numeric(.data$NATURE_EPCI), "_", .data$Zone),
45	7x	.data$TypeZone == "EPT" ~ as.character(.data$Zone),
46	7x	.data$TypeZone == "D\u00e9partements" ~ as.character(.data$CodeZone),
47	7x	TRUE ~ paste0(as.numeric(.data$CodeZone))) # on récupère le n° du facteur
48		) %>%
49	7x	dplyr::arrange(.data$TypeZone, .data$var_de_tri) %>%
50	7x	dplyr::mutate(
51	7x	Zone = forcats::fct_drop(.data$Zone) %>% forcats::fct_inorder(.),
52	7x	CodeZone = forcats::fct_drop(.data$CodeZone) %>% forcats::fct_inorder(.)
53		) %>%
54	7x	select(-"NATURE_EPCI", -"var_de_tri")
55	7x	return(res)
56		}

1
2		#' Creation de deux graphiques du chapitre sur les tensions sur le marche, representant l evolution du taux de vacance et de mobilite ces 5 dernieres annees pour la region et deux territoires supra de comparaison.
3		#' @description Création de deux graphiques représentant l'évolution du taux de vacance et du taux de mobilité sur 6 ans
4		#' (de 5 années avant l'année choisie jusqu'à l'année choisie), pour la region et deux territoires supra de comparaison.
5		#' @param data La table d'indicateurs préparée par dataprep() selon les inputs de l'utilisateur et filtrée sur le booléen Zone_ref.
6		#' @param annee Une année parmi les millésimes sélectionnables par l'utilisateur, au format numérique.
7		#' @param palette choix de la palette de couleur parmi celle de \code{gouvdown::\link{scale_color_gouv_discrete}}. Par defaut : "pal_gouv_qual2"
8		#' @param titre une chaine de caractère si vous voulez ajouter un titre spécifique. (par défaut: "Évolution de la vacance et de la mobilité)
9		#' @param titre_vacance une chaine de caractère si vous voulez ajouter un titre spécifique pour le taux de vacance. (par défaut: "Taux de vacance structurelle")
10		#' @param titre_mobilite une chaine de caractère si vous voulez ajouter un titre spécifique pour le taux de mobilite. (par défaut: "Taux de mobilité")